Import simple text to existing blocks as an additional attribute

May 19, 2021

Good morning all.

I have an issue in various drawings and I would like some help - if possible.

I have numerous drawings (>500) where I have simple text next to various blocks (with different names).

The blocks already contain attributes (i.e.1,2,3....N amount of attributes). What I would like to have is :

With a proximity parameter I would like to insert the text as a NEW attribute value (N+1) within the existing block that is closer to it.

The position of the new attribute should be the same as the position of the text.

The original block should not change a name. It shall also maintain the original insertion point.

A new block shall not be created. The attribute shall retain the layer information that the text originally had.

The attributes and their content that the block originally contained shall be retained.

Last, if within the proximity range, there are 2 values, add 2 attributes.

Is that even possible?

I have attached two drawings. The first how the current situation is (Drawing1.dwg) and how it should be (Drawing2.dwg).

The distances and offsets are real (for the proximity parameter). My drawings are designed in millimetres.

Thank you in advance.

Dgoutz

Drawing1.dwg Drawing2.dwg

May 22, 2021

Did you google add attribute existing block lisp that would be 1st step, it exists I dont have.

Then 2nd step is to find block look for text again pretty simple lots of examples

So as a newbie ie post 1 you will get lots more help if you do a bit of the leg work yourself, thinking about it now it has been done before so google. That is what I would do.

May 25, 2021

Good morning @BIGAL

Thank you for your response. What I need is too specific and google is not that helpful.

I was hoping that some LISP gury could help me within this site..

Thank you in advance.

Dgoutz

May 25, 2021

;; ; ; ;   https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-attach-existing-text-to-an-existing-block-as-an-attribute/td-p/8916790?fbclid=IwAR3MhpW44SSnUZbMaruDw6TI6uiCEb-JgTdDOzLKF6l38VG2fKTAVq92dCE
(defun C:Add_Tag ( / Text Txt_Ent BLK Txt_Lay Txt_Height def)
(setvar "cmdecho" 0)
(setq Text (cdr (assoc 1 (entget (setq Txt_Ent(car(entsel "\nSelect Text: ")))))))
(setq BLK (cdr (assoc 2 (entget (car(entsel "\nSelect Block: "))))))
(setq Txt_Lay (vlax-get (vlax-ename->vla-object Txt_Ent) 'layer))
(setq Txt_Height (vlax-get (vlax-ename->vla-object Txt_Ent) 'height))
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BLK))
(vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	 Text
	 (vlax-3D-point 0 (- (* 1.5 Txt_Height)))
	 Text
	 Text
)
(vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) Text)
			(vl-catch-all-apply 'vla-put-layer (list obj Txt_Lay))
		)
	)
)
(command "_.attsync" "_N" BLK)
(setvar "cmdecho" 1)
)

May 25, 2021

@hosneyalaa

Thank you for your post. However this lisp is performing a completely different action that the one I need.

I have different text next to many instances of the same block.

Therefore the block attribute needs to have a different value according to its own adjacent text.

Also, I don't want to manually select the text and the block because I have 50 different blocks and 30-40 different text values. Can you imagine the compilations?

I need all of them to be "automatic"

May 25, 2021

On 5/19/2021 at 5:46 AM, Dgoutz said:

The distances and offsets are real (for the proximity parameter)

how much could it change .?

if we use a circle radious 360 , will it alaways get the desired number

May 26, 2021

Your task is 2 steps not 1 amend the blocks then add text to blocks.

Like devitg that is the search method, you need to make a list of the block names then can add the attribute to that block definition, it should check does attribute exist and tag name exist. It may find wrong text.

Hosneyalaa has provided an example you can replace some of the requests like text ht and text string use say "-" you would replace the block name in the code from your list, also set tagstr to a name.

You need to supply a list of the blocks. You can use this it will print all blocks in your dwg so copy and paste to say notepad remove any not needed add others then you can make a lst.

(defun blknames ( / blks blkname)
(setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(princ "\n")
(vlax-for blkname blks
(princ (strcat "\n\"" (vla-get-name blkname) "\""))
)
(princ)
)
(blknames)

(setq lst '("blk1" "blk2" .... "blk32"))

Also had a look at dwg how do we know what is the new tagname to be can get how many atts and add 1 etc but if 5 and want Tag_7 very difficult. The circle is +1 the square is +1 but there is no tag4 so a count would conflict. A unique name would be better. Newtag_x

Edited May 26, 2021 by BIGAL

May 26, 2021

8 hours ago, devitg said:

how much could it change .?

if we use a circle radious 360 , will it alaways get the desired number

Good morning @devitg

It actually depends on the insertion point of the block and the position of the text. Is it possible to set this as an input to the lisp? Instead of setting a fixed 360mm distance, perhaps let the program ask me to enter this distance as a parameter? In that way we could be more flexible and do many tests until i find the suitable distance that applies to most or all blocks

May 26, 2021

5 hours ago, BIGAL said:
Your task is 2 steps not 1 amend the blocks then add text to blocks.

Like devitg that is the search method, you need to make a list of the block names then can add the attribute to that block definition, it should check does attribute exist and tag name exist. It may find wrong text.

Hosneyalaa has provided an example you can replace some of the requests like text ht and text string use say "-" you would replace the block name in the code from your list, also set tagstr to a name.

You need to supply a list of the blocks. You can use this it will print all blocks in your dwg so copy and paste to say notepad remove any not needed add others then you can make a lst.
(defun blknames ( / blks blkname)
(setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(princ "\n")
(vlax-for blkname blks
(princ (strcat "\n\"" (vla-get-name blkname) "\""))
)
(princ)
)
(blknames)
(setq lst '("blk1" "blk2" .... "blk32"))

Also had a look at dwg how do we know what is the new tagname to be can get how many atts and add 1 etc but if 5 and want Tag_7 very difficult. The circle is +1 the square is +1 but there is no tag4 so a count would conflict. A unique name would be better. Newtag_x

My drawings do not have a unique format...so that means that I do not have the same amount of blocks neither do they share common names.

Also there could be 50 block names at some drawings.

I know that I ask too much, but this method involves too much manual work and also requires a lot of edits to the LISP code (to include the block names).

To be honest, I would like to avoid manual work because specific routines minimize the margin for error apart from saving time!!

Couldn't we include this action within the lisp?

Also, I have no problem to set unique names like Newtag_x!!!

Thank you in advance for your efforts.

May 26, 2021

16 hours ago, Dgoutz said:

@hosneyalaa

Thank you for your post. However this lisp is performing a completely different action that the one I need.

I have different text next to many instances of the same block.

Therefore the block attribute needs to have a different value according to its own adjacent text.

Also, I don't want to manually select the text and the block because I have 50 different blocks and 30-40 different text values. Can you imagine the compilations?

I need all of them to be "automatic"

TRY

(defun c:TESTADDT(/ ptSet tPt ptLst outLst)
 (if
   (setq ptSet(ssget "_X" '((0 . "INSERT"))))
   (progn
     (setvar "cmdecho" 0)
(setq I 0) ; Order of POINT

            (while (< I (sslength ptSet) )

  
   (setq BLK (cdr (assoc 2 (entget (setq Txt_BLK(ssname ptSet I ))))))
  (setq BLK_INSERTIONPOINT (vlax-get (vlax-ename->vla-object Txt_BLK) 'INSERTIONPOINT))
  (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BLK))
  
     (setq ptLst(vl-sort
	   (mapcar '(lambda(x)(list(distance (cAr x) BLK_INSERTIONPOINT) (cadr x)))
	     (mapcar '(lambda(x)(list (cdr(assoc 10 x)) (cdr(assoc -1 x))))
                     (mapcar 'entget(vl-remove-if 'listp
                      (mapcar 'cadr(ssnamex (ssget "X" '((0 . "TEXT") (8 . "2") ))))))))
                '(lambda(a b)(<(car a)(car b)))))
  
     (setq outLst(CAR(cdr (cAr ptLst))))
   (setq Text (cdr (assoc 1 (entget outLst))))
  (setq Txt_INSERTIONPOINT (vlax-get (vlax-ename->vla-object outLst) 'INSERTIONPOINT))

  
(setq Txt_Lay (vlax-get (vlax-ename->vla-object outLst) 'layer))
(setq Txt_Height (vlax-get (vlax-ename->vla-object outLst) 'height))
  
( IF (= BLK "Circle_1")
  
  (PROGN
  (vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_3")
			(setq pipenamelist0 (LIST tagstr obj))
		)
	)
)
    ( IF (= pipenamelist0 NIL)

      (PROGN
                          
                          (setq daddattribut (vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	  "New Attribute"  ;;TAG_3
	 ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
         (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT ))                            
	 "TAG_3"
	 Text
))
            (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
            (command "_.attsync" "_N" BLK)
                          )
      (PROGN
                          (vla-put-TextString (CAR(CDR pipenamelist0)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                          (vla-put-ScaleFactor (CAR(CDR pipenamelist0)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                          (command "_.attsync" "_N" BLK)
                          )
      
  

 )
)

 )

  
  ( IF (= BLK "Square_1")
    (PROGN
  (vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_7")
			(setq pipenamelist (LIST tagstr obj))
		)
	)
)
    ( IF (/= pipenamelist NIL)


      (PROGN
                          (vla-put-TextString (CAR(CDR pipenamelist)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                          (vla-put-ScaleFactor (CAR(CDR pipenamelist)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                          (command "_.attsync" "_N" BLK)
                          )

      (PROGN
                          
                          (setq daddattribut (vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	  "New Attribute"  ;;TAG_3
	 ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
         (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT ))                            
	 "TAG_7"
	 Text
))
            (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
            (command "_.attsync" "_N" BLK)
                          )
      
  )

 )
)
  

           

  (SETQ I (+ 1 I))
  )
     ); end progn

   ); end if
  (setvar "cmdecho" 1)
 ); end of c:npts

May 26, 2021

3 hours ago, hosneyalaa said:

TRY


(defun c:TESTADDT(/ ptSet tPt ptLst outLst)
 (if
   (setq ptSet(ssget "_X" '((0 . "INSERT"))))
   (progn
     (setvar "cmdecho" 0)
(setq I 0) ; Order of POINT

            (while (< I (sslength ptSet) )

  
   (setq BLK (cdr (assoc 2 (entget (setq Txt_BLK(ssname ptSet I ))))))
  (setq BLK_INSERTIONPOINT (vlax-get (vlax-ename->vla-object Txt_BLK) 'INSERTIONPOINT))
  (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BLK))
  
     (setq ptLst(vl-sort
	   (mapcar '(lambda(x)(list(distance (cAr x) BLK_INSERTIONPOINT) (cadr x)))
	     (mapcar '(lambda(x)(list (cdr(assoc 10 x)) (cdr(assoc -1 x))))
                     (mapcar 'entget(vl-remove-if 'listp
                      (mapcar 'cadr(ssnamex (ssget "X" '((0 . "TEXT") (8 . "2") ))))))))
                '(lambda(a b)(<(car a)(car b)))))
  
     (setq outLst(CAR(cdr (cAr ptLst))))
   (setq Text (cdr (assoc 1 (entget outLst))))
  (setq Txt_INSERTIONPOINT (vlax-get (vlax-ename->vla-object outLst) 'INSERTIONPOINT))

  
(setq Txt_Lay (vlax-get (vlax-ename->vla-object outLst) 'layer))
(setq Txt_Height (vlax-get (vlax-ename->vla-object outLst) 'height))
  
( IF (= BLK "Circle_1")
  
  (PROGN
  (vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_3")
			(setq pipenamelist0 (LIST tagstr obj))
		)
	)
)
    ( IF (= pipenamelist0 NIL)

      (PROGN
                          
                          (setq daddattribut (vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	  "New Attribute"  ;;TAG_3
	 ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
         (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT ))                            
	 "TAG_3"
	 Text
))
            (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
            (command "_.attsync" "_N" BLK)
                          )
      (PROGN
                          (vla-put-TextString (CAR(CDR pipenamelist0)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                          (vla-put-ScaleFactor (CAR(CDR pipenamelist0)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                          (command "_.attsync" "_N" BLK)
                          )
      
  

 )
)

 )

  
  ( IF (= BLK "Square_1")
    (PROGN
  (vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_7")
			(setq pipenamelist (LIST tagstr obj))
		)
	)
)
    ( IF (/= pipenamelist NIL)


      (PROGN
                          (vla-put-TextString (CAR(CDR pipenamelist)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                          (vla-put-ScaleFactor (CAR(CDR pipenamelist)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                          (command "_.attsync" "_N" BLK)
                          )

      (PROGN
                          
                          (setq daddattribut (vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	  "New Attribute"  ;;TAG_3
	 ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
         (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT ))                            
	 "TAG_7"
	 Text
))
            (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
            (command "_.attsync" "_N" BLK)
                          )
      
  )

 )
)
  

           

  (SETQ I (+ 1 I))
  )
     ); end progn

   ); end if
  (setvar "cmdecho" 1)
 ); end of c:npts

I get a message "; error: bad argument type: lselsetp nil" and It does not work. Does this mean that I cannot find such a block?

May 26, 2021

53 minutes ago, Dgoutz said:

I get a message "; error: bad argument type: lselsetp nil" and It does not work. Does this mean that I cannot find such a block?

needs (vl-load-com)

(defun c:TESTADDT (/ ptSet tPt ptLst outLst)
  (vl-load-com)
  (if (setq ptSet (ssget "_X" '((0 . "INSERT"))))

Edited May 26, 2021 by mhupp

May 26, 2021

1 hour ago, mhupp said:

needs (vl-load-com)


(defun c:TESTADDT (/ ptSet tPt ptLst outLst)
  (vl-load-com)
  (if (setq ptSet (ssget "_X" '((0 . "INSERT"))))

Thank you mhupp
Yes, I forgot (vl-load-com)
Dgoutz Add this to the code

May 26, 2021

11 hours ago, Dgoutz said:

My drawings do not have a unique format...so that means that I do not have the same amount of blocks neither do they share common names.

Also there could be 50 block names at some drawings.

I know that I ask too much, but this method involves too much manual work and also requires a lot of edits to the LISP code (to include the block names).

To be honest, I would like to avoid manual work because specific routines minimize the margin for error apart from saving time!!

Couldn't we include this action within the lisp?

Also, I have no problem to set unique names like Newtag_x!!!

Thank you in advance for your efforts.

Quite a difucult task . It resemble me a Big chief order to his master hunter "go to jungle , hunt any animal specie, near by , but not so close o so far from a not know tree name, " the Master hunter would come maybe a bird, or a snake, near a pine tree or far from a breadtree. I wonder what the chief will say'.........................................

May 26, 2021

Like devitg about the only way is isolate layers before running so only have the blocks you want on and the text to find.

Dont know how your going to do for 500 dwgs unless there is some form of search pattern, the distance parameter is not a problem.

requires a lot of edits to the LISP code (to include the block names). I gave you make block list to file Autocad can open the file in notepad delete unwanted block names save, that is name in your lisp that reads block names, pretty quick.

Edited May 26, 2021 by BIGAL

May 27, 2021

23 hours ago, hosneyalaa said:

Thank you mhupp
Yes, I forgot (vl-load-com)
Dgoutz Add this to the code

Still having an error guys...

; error: bad argument type: lselsetp nil

May 27, 2021

1 hour ago, Dgoutz said:

Still having an error guys...

; error: bad argument type: lselsetp nil

Attach the drawing you are working on itself Until we try

It works fine In the drawing

that was attached in advance

May 27, 2021

@Dgoutz

REPLACE

 (setq ptSet (ssget "_X" '((0 . "INSERT"))))

With

 (setq ptSet (ssget "_X '((0 . "INSERT"))))

Then

choose only one block Does an error appear?

May 27, 2021

@hosneyalaa I think you meant for the second option to be.

(setq ptSet (ssget '((0 . "INSERT"))))

Beautified the code only (remove spaces) Thinking maybe they didn't select everything from the first time. Everything runs fine on Drawing1 they posted.

(defun c:TESTADDT (/ ptSet tPt ptLst outLst)
  (vl-load-com)    ;added
  (if (setq ptSet (ssget "_X" '((0 . "INSERT"))))
    (progn
      (setvar "cmdecho" 0)
      (setq I 0)  ; Order of POINT
      (while (< I (sslength ptSet))
        (setq BLK (cdr (assoc 2 (entget (setq Txt_BLK (ssname ptSet I))))))
        (setq BLK_INSERTIONPOINT (vlax-get (vlax-ename->vla-object Txt_BLK) 'INSERTIONPOINT))
        (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BLK))
        (setq ptLst (vl-sort
                      (mapcar '(lambda (x) (list (distance (cAr x) BLK_INSERTIONPOINT) (cadr x)))
                              (mapcar '(lambda (x) (list (cdr (assoc 10 x)) (cdr (assoc -1 x))))
                                      (mapcar 'entget (vl-remove-if 'listp
                                                                    (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT") (8 . "2")))))
                                                      )
                                      )
                              )
                      )
                      '(lambda (a b) (< (car a) (car b)))
                    )
        )
        (setq outLst (CAR (cdr (cAr ptLst))))
        (setq Text (cdr (assoc 1 (entget outLst))))
        (setq Txt_INSERTIONPOINT (vlax-get (vlax-ename->vla-object outLst) 'INSERTIONPOINT))
        (setq Txt_Lay (vlax-get (vlax-ename->vla-object outLst) 'layer))
        (setq Txt_Height (vlax-get (vlax-ename->vla-object outLst) 'height))
        (if (= BLK "Circle_1")
          (progn
            (vlax-for obj def
              (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
                (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_3")
                  (setq pipenamelist0 (LIST tagstr obj))
                )
              )
            )
            (if (= pipenamelist0 NIL)
              (progn
                (setq daddattribut (vla-addattribute def
                                                     Txt_Height
                                                     acattributemodelockposition
                                                     "New Attribute"  ;;TAG_3
                                                     ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
                                                     (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT))
                                                     "TAG_3"
                                                     Text
                                   )
                )
                (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                (command "_.attsync" "_N" BLK)
              )
              (progn
                (vla-put-TextString (CAR (CDR pipenamelist0)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                (vla-put-ScaleFactor (CAR (CDR pipenamelist0)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                (command "_.attsync" "_N" BLK)
              )
            )
          )
        )
        (if (= BLK "Square_1")
          (progn
            (vlax-for obj def
              (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
                (if (wcmatch (setq tagstr (vla-get-tagstring obj)) "TAG_7")
                  (setq pipenamelist (LIST tagstr obj))
                )
              )
            )
            (if (/= pipenamelist NIL)
              (progn
                (vla-put-TextString (CAR (CDR pipenamelist)) (vla-get-TextString (vlax-ename->vla-object outLst)))
                (vla-put-ScaleFactor (CAR (CDR pipenamelist)) (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                (command "_.attsync" "_N" BLK)
              )
              (progn
                (setq daddattribut (vla-addattribute def
                                                     Txt_Height
                                                     acattributemodelockposition
                                                     "New Attribute"  ;;TAG_3
                                                     ;;(vlax-3D-point 0 (- (* 1.5 Txt_Height)))
                                                     (vlax-3D-point (mapcar (function (lambda (a b) (- a b))) Txt_INSERTIONPOINT BLK_INSERTIONPOINT))
                                                     "TAG_7"
                                                     Text
                                   )
                )
                (vla-put-ScaleFactor daddattribut (vlax-get-property (vlax-ename->vla-object outLst) 'ScaleFactor))
                (command "_.attsync" "_N" BLK)
              )
            )
          )
        )
        (SETQ I (+ 1 I))
      )
    )  ; end progn
  )    ; end if
  (setvar "cmdecho" 1)
  (princ) ;added
); end of c:npts

Edited May 28, 2021 by mhupp

Sign In

Import simple text to existing blocks as an additional attribute

Recommended Posts

Dgoutz

BIGAL

Dgoutz

hosneyalaa

Dgoutz

devitg

BIGAL

Dgoutz

Dgoutz

hosneyalaa

Dgoutz

mhupp

hosneyalaa

devitg

BIGAL

Dgoutz

hosneyalaa

hosneyalaa

mhupp

Join the conversation

Tutorials

Forums

Activity