My lisp to number a block needs some help

**aawilds** · 2017-06-05, 03:17 PM

I have found this Lisp from Chaitanya Chikkala and it works great, but I was trying to edit it so that the selected blocks would be sorted by direction. I thought that I had it but I have hit a wall and could use some help.
The original code is

Code:

(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
)

I tried to replace the (SETQ BLOCK_LIST (SSGET)) to sort the selected blocks. I want to be able to pick a direction but right now I was trying to just get one direction to work. Here is what I have so far any help would be greatly appreciated.

Code:

(defun c:slab(/ potSet ss ent obj x i ST_STR)
  (princ "\n<<< Select points >>> ")
  (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)
  (SETQ BLOCK_LIST ((if
    (setq potSet(ssget '((0 . "INSERT") (8 . "POLE_ID"))))
    (setq ss (vl-sort
      (vl-remove-if 'listp
	 (mapcar 'cadr(ssnamex potSet)))
             '(lambda(x y)
		(>
		  (cadr(assoc 10(entget x)))
		  (cadr(assoc 10(entget y)))))))
    )))
  (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
)

**peter** · 2017-06-05, 06:22 PM

First of all I would suggest you present your question first without all of the borrowed code.

1.) Show and example of the drawing with the blocks you want to number
2.) Describe how you want to number them.

Basically create what is called a functional specification for the routine.

Create it as a flow chart list.
(just a step by step procedure written with words)

Then create your own routine to perform only the procedure you describe.

If you do it that way I would bet your code would be maybe 20 lines long.

2 cents.

Peter

**peter** · 2017-06-05, 08:49 PM

This is my attempt to write the routine as I understand it.

Things I wanted to share include,
1.) A header
2.) Break up functionality into command line and general functions
3.) Complete variable naming including variable type and contents description.
4.) Perform each step of the code one at a time and avoid compound expressions that may cause errors.
5.) Label each function with a description of its functionality.
6.) Be really clear
7.) Write all code from scratch using library functions

IMHO... Peter

Code:

;___________________________________________________________________________________________________________|
;
; Written By: Peter Jamtgaard  copyright 2017 All Rights Reserved
;___________________________________________________________________________________________________________|

;___________________________________________________________________________________________________________|
;
; Command Line Function Header List
;___________________________________________________________________________________________________________|

;* C:BlockNumber
;* Command line function to number a selection set of blocks

;___________________________________________________________________________________________________________|
;
; General Function Header List
;___________________________________________________________________________________________________________|
;
;  Function List		Argument1	Argument2 	Arguement3

;* (SelectionSetToList ssSelections)
;* Function to convert a lisp selection set to a list of vla-objects

;* (ListofSublistsSortbyItem lstOfSublists intItem)
;* Function for sorting a list of sublists in ascending order

;$ Header End

;___________________________________________________________________________________________________________|
;
; Command line function to number a selection set of blocks
;___________________________________________________________________________________________________________|

(defun C:BlockNumber (/ intNumber lstAttributeObjects lstObjects lstOfSublists objAttribute objSelection strPrefix ssSelections)
 (if (and (setq strPrefix (getstring "\nEnter Alphanumeric Prefix: "))
          (setq intNumber (getint    "\nEnter Numeric Suffix: "))
          (princ "\nSelect Blocks: ")
          (setq ssSelections (ssget (list (cons 0 "INSERT")(cons 66 1))));   (cons 8 "POLE_ID")
          (setq lstObjects    (SelectionSetToList ssSelections))
          (setq lstOfSublists (mapcar '(lambda (X)(cons X (vlax-get X "insertionpoint"))) lstObjects))
          (setq lstOfSublists (ListofSublistsSortbyItem lstOfSublists 1)) ; You can add a reverse here to Reverse order
          (setq lstOfSublists (ListofSublistsSortbyItem lstOfSublists 2)) ; You can add a reverse here to Reverse order
     )
  (foreach objSelection (mapcar 'car lstOfSublists))
   (and
    (setq lstAttributeObjects (vlax-invoke objSelection "getattributes"))
    (setq objAttribute        (car lstAttributeObjects))
    (vla-put-textstring objAttribute (strcat strPrefix (itoa intNumber)))
   )
   (setq intNumber (1+ intNumber))
  )
 )
)

;___________________________________________________________________________________________________________|
;
; 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
)

;___________________________________________________________________________________________________________ 
;
; Function for sorting a list of sublists in ascending order
;___________________________________________________________________________________________________________


(defun ListofSublistsSortbyItem (lstOfSublists intItem)
 (vl-sort lstOfSublists '(lambda (X Y) (< (nth intItem X) (nth intItem Y))))
)


(princ "!")
(vl-load-com)

**aawilds** · 2017-06-06, 03:38 PM

Thank you Peter. That works, I have been struggling with this for a while.

**peter** · 2017-06-06, 04:33 PM

I was hoping to help you not only solve the puzzle but also help you learn to code.

I have adopted the above format in all of my code and have been able to build extensive libraries that make code stable and easy to create....

Hope it helps.

P

Thread: My lisp to number a block needs some help

Thread Tools

Display

My lisp to number a block needs some help

Re: My lisp to number a block needs some help

Re: My lisp to number a block needs some help

Re: My lisp to number a block needs some help

Re: My lisp to number a block needs some help

Similar Threads

need lisp code to sum only number in texts/mtext

Auto number attribute lisp fix

a lisp to know if a number is PRIME or NOT

How to get the number of opening drawing and its name in Lisp ?

Help with number placing LISP routine

Tags for this Thread

Posting Permissions