Help fixing lisp

Help fixing lisp

Hamza.itani
Contributor Contributor
393 Views
3 Replies
Message 1 of 4

Help fixing lisp

Hamza.itani
Contributor
Contributor

I use this lisp to add a prefix and increment number for blocks with attributes. My blocks have multiple Attributes, each with a different TAG. Can someone help to modify the following lisp so that the Attributed Tagged "SN" (without quotes) is the one to replace with the increment?

(defun c:incr (/ ent obj x i ST_STR)
 (command "._undo" "_be")
 (SETQ ST_STR1 (GETSTRING "\nENTER PREFIX: "))
 (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER: "))
 (vl-load-com)
 (setq i 0)
 (prompt "\nSelect blocks")
 (SETQ BLOCK_LIST (ssget '((0 . "INSERT"))))
 (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
)

 

 

0 Likes
Accepted solutions (2)
394 Views
3 Replies
Replies (3)
Message 2 of 4

Hamza.itani
Contributor
Contributor

Attached Example Drawing, The above lisp always changes the Elevation Attribute. I need it to change the SN attribute instead.

0 Likes
Message 3 of 4

pbejse
Mentor
Mentor
Accepted solution

@Hamza.itani wrote:

Attached Example Drawing, The above lisp always changes the Elevation Attribute. I need it to change the SN attribute instead.


Quick fix is

(SETQ TEMP_ELE (NTH 0 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST))))

to

(SETQ TEMP_ELE (NTH 2 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST))))

 

Message 4 of 4

pbejse
Mentor
Mentor
Accepted solution

Modified main routine

(defun c:incr (/ st_str1  st_str at_tag block_list i st_str_)
(command "._undo" "_be")
(if
  (and  
 	(setq st_str1 (getstring "\nEnter Prefix: "))
 	(setq st_str (getstring "\nEnter Starting number: "))
  	(setq at_tag (strcase (getstring "\nEnter Tagname: ")))
	(princ "\nselect blocks")
	(setq block_list (ssget '((0 . "insert")(66 . 1)) ))	
	)
  (progn
 	(setq i 0) 		 
 	(setq block_list (form_ssset block_list))
 	(while (< i (length block_list))
	   (setq st_str (strcat "" st_str))
(setq temp_ele (attribute_extract (nth i block_list))) (if (assoc at_tag temp_ele) (progn (setq temp_attribute (strcat st_str1 st_str)) (modify_attributes (nth i block_list) (list at_tag) (list temp_attribute)) (setq st_str (itoa (+ (atoi st_str) 1))) ) (princ (Strcat "\nTag " at_tag " Not found")) ) (setq i (+ i 1)) ) ) ) (command "._undo" "_e") (princ))

HTH