Jump to content

Prefix and number increment autolisp

aawilds

By aawilds
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

aawilds Explorer

aawilds

Posted
Posted

Hello, I am looking for a lisp that will allow me to increment an attribute in a block from one block to the next by doing a window selection. The lisp that I have now that I got from Chaitanya Chikkala (see below) works great, but I have to select each block individually. With 2000+ blocks it is easy to make a mistake. When I window select with it, it numbers them as they were added to the drawing. This does not work for me because multiple people work on drawings and then are combined into a master drawing so the order is wrong. Is there a way for a direction to be added, even if it is just along the x or y axis? Or is there a lisp that already does this? Any help is very much appreciated.

 

(defun c:incr (/ ent obj x i ST_STR)
 (command "._undo" "_be")
 (SETQ ST_STR1 (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY ALPHABET/WORD)"))
 (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)"))
 (vl-load-com)
 (setq i 0)
 (prompt "\nSelect blocks one at a time and in order")
 (SETQ BLOCK_LIST (SSGET))
 (SETQ BLOCK_LIST (FORM_SSSET BLOCK_LIST))
 (while (< I (LENGTH BLOCK_LIST))
   (SETQ ST_STR (STRCAT "" ST_STR))
    (SETQ TEMP_ELE (NTH 0 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST))))
   (SETQ TEMP_ATTRIBUTE (STRCAT ST_STR1 ST_STR))
   (SETQ TEMP_TAG (NTH 0 TEMP_ELE))
   (MODIFY_ATTRIBUTES (NTH I BLOCK_LIST) (LIST TEMP_TAG) (LIST TEMP_ATTRIBUTE))
   (SETQ ST_STR (ITOA (+ (ATOI ST_STR) 1)))
   (setq i (+ i 1))

 )
 (command "._undo" "_e")

 (princ))




(DEFUN FORM_SSSET (SSSET / I TEMP_ELE LIST1)
 (SETQ I 0)
 (SETQ TEMP_ELE NIL)
 (SETQ LIST1 NIL_)
 (WHILE (< I (SSLENGTH SSSET))
   (SETQ TEMP_ELE (SSNAME SSSET I))
   (SETQ LIST1 (CONS TEMP_ELE LIST1))
   (SETQ I (+ I 1))
 )
 (REVERSE LIST1)
)



(DEFUN ATTRIBUTE_EXTRACT (ENTNAME / ENT_OBJECT SAFEARRAY_SET I LIST1)
 (SETQ SAFEARRAY_SET NIL)
 (SETQ ENT_OBJECT ENTNAME)
 (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT))
 (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE)
 (PROGN
 (SETQ	SAFEARRAY_SET
 (VLAX-SAFEARRAY->LIST
   (VLAX-VARIANT-VALUE
     (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES")
   )
 )
 )

 (SETQ I 0)
 (SETQ LIST1 NIL)
 (WHILE (< I (LENGTH SAFEARRAY_SET))
   (SETQ
     LIST1 (CONS
      (LIST
	(VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING")
	(VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING")
	
        
      )
      LIST1
    )
   )
   (SETQ I (+ I 1))
 )
 (SETQ LIST1 (REVERSE LIST1))
 (SETQ LIST1 (SORT_FUN LIST1 0 0)))
   (SETQ LIST1 NIL)
   )LIST1
 
)



(DEFUN MODIFY_ATTRIBUTES (ENTNAME IDENTIFIER VALUE / TEMP_ELE ENT_OBJECT SAFEARRAY_SET I J)
 (SETQ SAFEARRAY_SET NIL)
 (SETQ ENT_OBJECT ENTNAME)
 (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT))
 (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE)
 (PROGN
 (SETQ	SAFEARRAY_SET
 (VLAX-SAFEARRAY->LIST
   (VLAX-VARIANT-VALUE
     (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES")
   )
 )
 )

 (SETQ I 0)
 (SETQ J 0)
 (SETQ LIST1 NIL)
 (WHILE (< I (LENGTH SAFEARRAY_SET))
   (SETQ TEMP_ELE (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING"))
   (IF (/= (VL-POSITION TEMP_ELE IDENTIFIER) NIL) (PROGN (VLAX-PUT-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING" (NTH (VL-POSITION TEMP_ELE IDENTIFIER) VALUE)) ))
   (SETQ I (+ I 1))
 )  
)))



(DEFUN SORT_FUN	(LIST1 FLAG1 FLAG2 /)
 (IF (= NIL (VL-CONSP (CAR LIST1)))
   (PROGN (SETQ LIST1 (INDEX_ADD LIST1))
   (SETQ LIST1
	  (VL-SORT LIST1
		   '(LAMBDA (X Y) (< (CADR X) (CADR Y)))
	  )
   )
   (SETQ LIST1 (MAPCAR '(LAMBDA (X) (CADR X)) LIST1))
   )
   (PROGN
     (IF (NOT (ATOM (NTH FLAG1 (NTH 0 LIST1))))
(SETQ LIST1
       (VL-SORT
	 LIST1
	 '(LAMBDA (X Y)
	    (< (NTH FLAG2 (NTH FLAG1 X)) (NTH FLAG2 (NTH FLAG1 Y)))
	  )
       )
)
(PROGN (SETQ LIST1
	      (VL-SORT LIST1
		       '(LAMBDA (X Y) (< (NTH FLAG2 X) (NTH FLAG2 Y)))
	      )
       )
)
     )
   )
 )
 LIST1
)

Jef! Rising Star

Jef!

Posted
Posted

Hi aawilds.

 

Without reinventing the wheel, an easy modification can be made to your code by adding some sorting into the function that handle the selection FORM_SSSER

 

...
[i][b]  (setq LIST1 (VL-SORT LIST1
          '(LAMBDA (X Y) (< (caddr(assoc 10 ([u]entget[/u] X))) (caddr(assoc 10 ([u]entget[/u] Y)))))
	      ))
 (setq LIST1 (VL-SORT LIST1
          '(LAMBDA (X Y) (> (cadr(assoc 10 ([u]entget[/u] X))) (cadr(assoc 10 ([u]entget[/u] Y)))))[/b][/i]
...

If I was to create from scratch that lisp, I would take another approach. Sorting makes a lot of comparisons (here for 2000 objects it makes 32112 comparisons.) The comparison qty is not the issue, it is more the fact that each comparison retrieve 2 entities dxf list (entget).

On my side for 2000 blocks it takes approximately 1 second, so overall instead of saving 15 minutes by manually selecting you will "only save 14min59". Not the most efficient, but as they say "Oh well" :D

 

but.. oops!: on my side after the change your code made an error "; error: ActiveX Server returned the error: unknown name: HASATTRIBUTES" even if it seems to get the job done. I went to look for "hasattributes", found at 2 places, and as I never seen vlax-g-p used like that before, I tried change both lines (in ATTRIBUTE_EXTRACT and MODIFY_ATTRIBUTES functions)

(IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE)
for 
(IF (vlax-property-available-p ENT_OBJECT "HASATTRIBUTES")

but then I got that error "; error: bad argument type: consp nil".

Basically it checks if it has attributes before retrieving or populating attributes, but aparently doesn't handle the nil returned IF a list cannot be made whenever no attributes are on one of the objects selected. Since you have 2000+ you might not want to be carefull when selecting them to select exclusively inserts, so I solve that fast and sweet by replacing the (ssget) by (ssget '((0 . "INSERT"))), which remove instantly everything that is not an insert when the selection is first made. Heres the code with the changes

(progn
(defun c:incr (/ ent obj x i ST_STR)
 (command "._undo" "_be")
 (SETQ ST_STR1 (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY ALPHABET/WORD)"))
 (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)"))
 (vl-load-com)
 (setq i 0)
 (prompt "\nSelect blocks one at a time and in order")
 (SETQ BLOCK_LIST (ssget[i][b] '((0 . "INSERT"))[/b][/i])) ;;;;;;;; Jef!
 (SETQ BLOCK_LIST (FORM_SSSET BLOCK_LIST))
 (while (< I (LENGTH BLOCK_LIST))
   (SETQ ST_STR (STRCAT "" ST_STR))
    (SETQ TEMP_ELE (NTH 0 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST))))
   (SETQ TEMP_ATTRIBUTE (STRCAT ST_STR1 ST_STR))
   (SETQ TEMP_TAG (NTH 0 TEMP_ELE))
   (MODIFY_ATTRIBUTES (NTH I BLOCK_LIST) (LIST TEMP_TAG) (LIST TEMP_ATTRIBUTE))
   (SETQ ST_STR (ITOA (+ (ATOI ST_STR) 1)))
   (setq i (+ i 1))

 )
 (command "._undo" "_e")

 (princ)
)

(DEFUN FORM_SSSET (SSSET / I TEMP_ELE LIST1)
 (SETQ I 0)
 (SETQ TEMP_ELE NIL)
 (SETQ LIST1 NIL_)
 (WHILE (< I (SSLENGTH SSSET))
   (SETQ TEMP_ELE (SSNAME SSSET I))
   (SETQ LIST1 (CONS TEMP_ELE LIST1))
   (SETQ I (+ I 1))
 )
[i][b]  (setq LIST1 (VL-SORT LIST1
          '(LAMBDA (X Y) (< (caddr(assoc 10 (entget X))) (caddr(assoc 10 (entget Y)))))
	      ))
 (setq LIST1 (VL-SORT LIST1
          '(LAMBDA (X Y) (> (cadr(assoc 10 (entget X))) (cadr(assoc 10 (entget Y)))))
	      ))[/b][/i]
 (REVERSE LIST1)
)

(DEFUN ATTRIBUTE_EXTRACT (ENTNAME / ENT_OBJECT SAFEARRAY_SET I LIST1)
 (SETQ SAFEARRAY_SET NIL)
 (SETQ ENT_OBJECT ENTNAME)
 (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT))
 (IF [b][i](vlax-property-available-p ENT_OBJECT "HASATTRIBUTES")[/i][/b];;; Jef!
 (PROGN
 (SETQ	SAFEARRAY_SET
 (VLAX-SAFEARRAY->LIST
   (VLAX-VARIANT-VALUE
     (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES")
   )
 )
 )
 (SETQ I 0)
 (SETQ LIST1 NIL)
 (WHILE (< I (LENGTH SAFEARRAY_SET))
   (SETQ
     LIST1 (CONS
      (LIST
	(VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING")
	(VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING")
      )
      LIST1
    )
   )
   (SETQ I (+ I 1))
 )
 (SETQ LIST1 (REVERSE LIST1))
 (SETQ LIST1 (SORT_FUN LIST1 0 0)))
   (SETQ LIST1 NIL)
   )LIST1
)

(DEFUN MODIFY_ATTRIBUTES (ENTNAME IDENTIFIER VALUE / TEMP_ELE ENT_OBJECT SAFEARRAY_SET I J)
 (SETQ SAFEARRAY_SET NIL)
 (SETQ ENT_OBJECT ENTNAME)
 (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT))
 (IF [i][b](vlax-property-available-p ENT_OBJECT "HASATTRIBUTES")[/b][/i] ;;;; Jef!
 (PROGN
 (SETQ	SAFEARRAY_SET
 (VLAX-SAFEARRAY->LIST
   (VLAX-VARIANT-VALUE
     (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES")
   )
 )
 )
 (SETQ I 0)
 (SETQ J 0)
 (SETQ LIST1 NIL)
 (WHILE (< I (LENGTH SAFEARRAY_SET))
   (SETQ TEMP_ELE (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING"))
   (IF (/= (VL-POSITION TEMP_ELE IDENTIFIER) NIL) (PROGN (VLAX-PUT-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING" (NTH (VL-POSITION TEMP_ELE IDENTIFIER) VALUE)) ))
   (SETQ I (+ I 1))
 )  
)))

(DEFUN SORT_FUN	(LIST1 FLAG1 FLAG2 /)
 (IF (= NIL (VL-CONSP (CAR LIST1)))
   (PROGN (SETQ LIST1 (INDEX_ADD LIST1))
   (SETQ LIST1
	  (VL-SORT LIST1
		   '(LAMBDA (X Y) (< (CADR X) (CADR Y)))
	  )
   )
   (SETQ LIST1 (MAPCAR '(LAMBDA (X) (CADR X)) LIST1))
   )
   (PROGN
     (IF (NOT (ATOM (NTH FLAG1 (NTH 0 LIST1))))
(SETQ LIST1
       (VL-SORT
	 LIST1
	 '(LAMBDA (X Y)
	    (< (NTH FLAG2 (NTH FLAG1 X)) (NTH FLAG2 (NTH FLAG1 Y)))
	  )
       )
)
(PROGN (SETQ LIST1
	      (VL-SORT LIST1
		       '(LAMBDA (X Y) (< (NTH FLAG2 X) (NTH FLAG2 Y)))
	      )
       )
)
     )
   )
 )
 LIST1
)
)

the sorting will look like that

att01 att04 att07

att02 att05 att08

att03 att06 att09

 

Cheers

@broncos, you say your code wasn't working, was your issues similar as mine?

aawilds Explorer

aawilds

Posted
  • Author
Posted

Thank you so much Jef. That works just like I want. I have been struggling with this for a while, so thank you again.:celebrate:

Jef! Rising Star

Jef!

Posted
Posted

Nice emoticon hahaha.

 

I'm glad I could help you out! :)

  • 2 years later...
Tony360 Newbie

Tony360

Posted
Posted

I need a lisp that will allow me to pick a bunch of attributes, and depending on the number I choose I can go up one, two, three etc. or down one etc. I need it to ignore alpha characters. For example I have 11S, 12S, 13S and I would like them to go up by 5 to be 16S, 17S, 18S for example.

pkenewell Experienced

pkenewell

Posted
Posted

Read this excerpt from Lee Mac's program:

 

http://www.lee-mac.com/numinc.html

Replace Existing Annotation Content

Upon pressing R or r during object placement, the user may select a primary or nested text, mtext, single-line & multiline attribute, dimension, or multileader containing mtext or attributed block content.

Following a valid selection, the text content of the selected annotation object will be updated to display the incrementing string.

If the selected attributed block or multileader attributed block contains more than one attribute, the user will be prompted to specify the tag of the attribute whose value is to be replaced with the sequential text string.

The user can exit this mode and return to standard text placement by pressing Enter, Space, or by Right-clicking the mouse at the prompt.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...