See the top rated post in this thread. Click here

Results 1 to 6 of 6

Thread: Replace text with block and transfer value into attribute

  1. #1
    Woo! Hoo! my 1st post
    Join Date
    2013-09
    Posts
    1
    Login to Give a bone
    0

    Default Replace text with block and transfer value into attribute

    Dear all,

    I need a lisp routine which basicly performs the action below:

    I have only room number as mtext objects. What I want to achieve is:

    I defined a block with attribute inside named ROOM_NO,
    I want to replace each mtext object with this block while getting the value into the attribute.

    The issue comes from migrating the drawing from Revit to AutoCad. Revit exports the room tags as mtext objects and I need to covert them to proper blocks with attibute. I have over 3000 rooms which is why a lisp routing comes in handy.

    Regards,

    MA

  2. #2
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Replace text with block and transfer value into attribute

    Once you create or insert the block with the attribute inside the drawing that I call "RoomNumber"

    Code:
    ;___________________________________________________________________________________________________________|
    ;
    ; Written By: Peter Jamtgaard C.E., P.E., S.E. copyright 2020 All Rights Reserved
    ;___________________________________________________________________________________________________________|
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Command Line Function Header List
    ;___________________________________________________________________________________________
    
    ;  Function and Description
    
    ;* C:RoomNumber
    ;* Command line Function to convert mtext entities to a block with an attribute
    
    ;___________________________________________________________________________________________________________|
    ;
    ; General Function Header List 
    ;___________________________________________________________________________________________________________|
    
    ;  Function, Arguments and Description
    
    ;* (Attributes objBlock)
    ;* Function to get a list of attributes from a block object
    
    ;* (ErrorTrap symFunction)
    ;* Function to capture error in symfunction expression
    
    ;* (ObjectMiddlePoint objSelection)
    ;* Function to get the middle of a bounding box from a vla-object
    
    ;* (OwnerObject objDocument objSelection)
    ;* Function to get the vla-object owner of a vla-object give the document and initial object
    
    ;* (SelectionSetToList ssSelections)
    ;* Function to convert a lisp selection set to a list of vla-objects
    
    ;___________________________________________________________________________________________________________|
    ;___________________________________________________________________________________________________________|
    
    ;$ Header End
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Command line Function to convert mtext entities to a block with an attribute
    ;___________________________________________________________________________________________________________|
    
    
    (defun C:RoomNumber (/ intOwnerID lstAttributes lstInsertion  lstSelections objActiveDocument 
                           objAttribute objBlock ssSelections strTextString)
     (if (and (setq objActiveDocument (vla-get-activedocument (vlax-get-acad-object)))
              (setq ssSelections  (ssget (list (cons 0 "MTEXT"))))
              (setq lstSelections (SelectionSetToList ssSelections))
         )
      (foreach objMtext lstSelections
       (and
        (setq lstInsertion  (ObjectMiddlePoint objMtext))
        (errortrap '(setq sngRotation (vla-get-rotation objMText)))
        (setq strTextString (vla-get-textstring objMtext))
        (setq objOwner      (ownerObject objActiveDocument objMtext))
        (errortrap '(setq objBlock (vlax-invoke objOwner "InsertBlock" lstInsertion "RoomNumber" 1.0 1.0 1.0 sngRotation)))
        (setq lstAttributes (attributes objBlock))
        (setq objAttribute  (car lstAttributes))
        (errortrap '(vla-put-textstring objAttribute strTextString))
        (errortrap '(vla-put-layer objBlock (vla-get-layer objMtext)))
        (errortrap '(vla-delete objMtext))
       )
      )
     )
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to get a list of attributes from a block object
    ;___________________________________________________________________________________________________________|
    
    (defun Attributes (objBlock)
     (if (and (vlax-property-available-p objBlock "hasattributes")
              (= (vla-get-hasattributes objBlock) :vlax-true)
         )
      (vlax-invoke objBlock "getattributes")
     )
    )
    
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to capture error in symfunction expression
    ;___________________________________________________________________________________________________________|
    
    (defun ErrorTrap (symFunction / objError result)
     (if (not
          (vl-catch-all-error-p
           (setq objError (vl-catch-all-apply
                          '(lambda (X)(set X (eval symFunction)))
                           (list 'result)))))
      (if result result 'T)
     )
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to get the middle of a bounding box from a vla-object
    ;___________________________________________________________________________________________________________|
    
    (defun ObjectMiddlePoint (objSelection / lstPoint1 lstPoint2 safPoint1 safPoint2)
     (if (and (errortrap '(vla-getboundingbox objSelection 'safPoint1 'safPoint2))
              (errortrap '(setq lstPoint1 (vlax-safearray->list safPoint1)))
              (errortrap '(setq lstPoint2 (vlax-safearray->list safPoint2)))
         )
      (mapcar '(lambda (X Y)(/ (+ X Y) 2.0)) lstPoint1 lstPoint2)
     )
    )
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to get the vla-object owner of a vla-object give the document and initial object
    ;___________________________________________________________________________________________________________|
    
    (defun OwnerObject (objDocument objSelection / intOwnderID objActiveDocument objOwner)
     (if (and (errortrap '(setq intOwnerID (vla-get-ownerid objSelection)))
              (errortrap '(setq objOwner (vla-objectidtoobject objDocument intOwnerID)))
         )
      objOwner
     )
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to convert a lisp selection set to a list of vla-objects
    ;___________________________________________________________________________________________________________|
    
    (defun SelectionSetToList (ssSelections / entSelection intCount objSelection lstObjects)
     (repeat (setq intCount (sslength ssSelections))
      (and (setq intCount     (1- intCount))
           (setq entSelection (ssname ssSelections intCount))
           (setq objSelection (vlax-ename->vla-object entSelection))
           (setq lstObjects   (cons objSelection lstObjects))
      )
     )
     lstObjects
    )
    
    (princ "!")
    (vl-load-com)
    Attached Files Attached Files
    Last edited by peter; 2020-12-12 at 02:56 AM.
    AutomateCAD

  3. #3
    All AUGI, all the time
    Join Date
    2010-06
    Posts
    962
    Login to Give a bone
    0

    Default Re: Replace text with block and transfer value into attribute

    This thread was solved on Cadtutor.
    THIS LINK

  4. #4
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    1

    Default Re: Replace text with block and transfer value into attribute

    Even if there is another solution to the puzzle.

    There are usually many ways to skin a cat.

    Part of the fun of participating in the forums is to solve a puzzle without looking at the other solutions.

    On occasion I find a nice solution that would change the way I would solve something, but usually I like to solve it for myself.

    Solutions that do not include errortrapping and good variable/function naming conventions along with complete notes are unstable and extremely difficult to read.

    My solutions are focused now on stability and readability.

    Good examples for others who visit the site make it easy to learn and build their own functions.

    Plus I just like to solve them for fun.

    P=
    AutomateCAD

  5. #5
    Member
    Join Date
    2000-12
    Posts
    6
    Login to Give a bone
    0

    Default Re: Replace text with block and transfer value into attribute

    Should this utility, RoomNumber, be compatible with AutoCAD 2019 and later?

    I receive this error when the code begins to process the selected Mtext objects:

    ; error: bad argument type: listp T

    The error occurs in the ObjectMiddlePoint function when it is running the 'vla-getboundingbox' function.

    Visual LISP is loaded. This 'vla-getboundingbox' function works in several other programs I have tested.


    Regards,
    Jerry

  6. #6
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Replace text with block and transfer value into attribute

    I revised the code below.

    There was an error in the errortrap function that returned a T instead of a result.

    Peter
    Last edited by peter; 2020-12-12 at 02:57 AM.
    AutomateCAD

Similar Threads

  1. Replies: 2
    Last Post: 2017-03-08, 06:27 PM
  2. 2014: Wildcard key-in for Find/Replace text in attribute
    By imacad in forum AutoCAD General
    Replies: 9
    Last Post: 2015-08-04, 03:23 PM
  3. Replies: 3
    Last Post: 2015-06-26, 04:55 PM
  4. Find a block attribute by Tag and replace Value
    By montana.fox in forum VBA/COM Interop
    Replies: 14
    Last Post: 2006-09-14, 03:07 PM
  5. Replace existing Border while keeping Attribute Text
    By neilcheshire in forum AutoCAD LT - General
    Replies: 2
    Last Post: 2006-07-20, 10:26 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •