topic Re: Stairs numbering LISP in Visual LISP, AutoLISP and General Customization Forum

Stairs numbering LISP

leeUT3Y6 — Tue, 28 Jan 2020 09:48:16 GMT

Hi,
I'm looking for a LISP to number stairs blocks in a incremental order.
I'm trying to modify a LISP I found on the web. This LISP is good, it modify the attributes in incremental sequence by sorting the blocks by its posiotions.
The only problem is that it does it on both Y and X axis, while I need only one axis at a time.
I belive it should be an easy task, but I could not succeed making the necesery changes, as I'm new to LISPs.

Thanks
Lee

(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_STR1 "")
 (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)"))
 (vl-load-com)
 (setq i 0)
 (prompt "\nSelect blocks")
 (SETQ BLOCK_LIST (ssget '((0 . "INSERT")))) ;;;;;;;; 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))
 )
(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)))))
	      ))
 (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-property-available-p ENT_OBJECT "HASATTRIBUTES")
 (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-property-available-p ENT_OBJECT "HASATTRIBUTES")
 (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
)
)

Re: Stairs numbering LISP

ВeekeeCZ — Tue, 28 Jan 2020 10:56:40 GMT

@leeUT3Y6 wrote:

(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_STR1 "")
 (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)"))
 (vl-load-com)
 (setq i 0)
 (prompt "\nSelect blocks")
 (SETQ BLOCK_LIST (ssget '((0 . "INSERT")))) ;;;;;;;; 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))
 )
;(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)))))
	      ))
 (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-property-available-p ENT_OBJECT "HASATTRIBUTES")
 (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-property-available-p ENT_OBJECT "HASATTRIBUTES")
 (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 red part sorts by Y, the blue one by X. Just turn the one you don't need off by adding semicolons, as I did.

Re: Stairs numbering LISP

leeUT3Y6 — Tue, 28 Jan 2020 12:05:43 GMT

I did the change as you suggested and it's still not working...

Re: Stairs numbering LISP

ВeekeeCZ — Tue, 28 Jan 2020 12:16:34 GMT

Then try to better explain your goal.

Use smaller dwg.

Illustrate the initial state, whats doing the routine now and what do you want to have.

Re: Stairs numbering LISP

leeUT3Y6 — Tue, 28 Jan 2020 13:18:14 GMT

Ok, I'll try to be more specific.
Please see the dwg file attached on the first comment.
There are over 112 stairs blocks, which I 'd like thier attributes to start from 1 on the first stair, till 112 on the last stair block.
The original script was build to set the attribute this way:
att01 att04 att07

att02 att05 att08

att03 att06 att09

I'd like to ignore the Y axis so the stairs will be only incremented by the X position.
So the result will be as:

att03

att02

att01

Thanks

Re: Stairs numbering LISP

ВeekeeCZ — Tue, 28 Jan 2020 13:28:17 GMT

OK, then my prior suggestion was good, just the other way around.

Remove the semicolons from the red ones, add them prior to blue ones.

Re: Stairs numbering LISP

CodeDing — Tue, 28 Jan 2020 13:31:29 GMT

@leeUT3Y6 ,

@leeUT3Y6 wrote:
...start from 1 on the first stair, till 112 on the last stair block.

You say from 1 to 112, yet you have 224 blocks in your provided drawing?

Also, all of them have the same attributes and numbering in them..

Also, there are 2 different blocks in your provided drawing..

I appreciate you trying to explain for us, but I believe in this case that it would help us greatly if you could provide us with a drawing that depicts the BEFORE and AFTER states of what you want. We could help you come to a solution much more effectively.

Best,

~DD

Re: Stairs numbering LISP

leeUT3Y6 — Wed, 29 Jan 2020 08:08:11 GMT

Yessss! It works!
Thanks 🙏