Autonumbering Dynamic Blocks in Order Left to Right, Top to Bottom

[Phvl]

 

First of all my experience is lisp is minimal. This being said, i was wondering if anyone could help me with this lisp.

 

The lisp below select multiple dynamic blocks, give it a main number (parameter) followed by a sequence number (other parameter).
 

(defun C:Num(/ Niveau blk blkname parafdek parnr props ss i Volgnr )
 
 (setq blkname '("BB" "FZ"))
 (setq parafdek "Niveau")
 (setq parnr "Volgnr")
 (setq Niveau (getreal "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): "))
	(if (setq ss (ssget (list '(0 . "INSERT") '(2 . "`*U*,blkname") '(66 . 1))))
		(progn
				(setq i 0)
				(setq Volgnr 1)
				(while (setq ent (ssname ss i))
					(setq blk (vlax-ename->vla-object (ssname ss i)))
					(setq props (vlax-safearray->list(variant-value(vla-getdynamicblockproperties blk))))
					(foreach param props
						(if (eq parafdek (vla-get-propertyname param))
							(vlax-put-property param "Value" (vlax-make-variant Niveau 5))
							(vla-update blk)
						)
						(if (eq parnr (vla-get-propertyname param))
							(vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
							(vla-update blk)
						)
					)
					(setq Volgnr (1+ Volgnr))
					(setq i (1+ i))
				)
			)
		)
	)
 (princ)
 )
(vl-load-com)

 

I just want to order the sequence numbers from left to right, top to bottom in the selection set.

 

All I can think of is to sort the (x,y) coordinates of the insertion point of the dynamic blocks first. 

 

Definitely not correct but maybe something like this:

 

(setq inspt (cdr (assoc 10 (entget (ssname ss i)))))
					
(setq ptx (car inspt)) ; X-punt
(setq pty (cadr inspt)) ; Y-punt
(setq ptz (caddr inspt)) ; Z-punt
					
(setq pt (list ptx pty ptz))
					
(setq PT_list (list pt))
(setq PT_list (append PT_list (list pt)))
					
(setq PT_list (vl-sort lst '(lambda (x y) (if (= (car x) (car y)) (> (cadr x) (cadr y)) (< (car x) (car y))))))

 

Thanks in advance.

[BIGAL]

Maybe this

 

(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
	    )
	  )
)
)

 

[mhupp]

This is what I have. builds a list of points from selection set. then step thought selection set again and update block that matches the point.

 

(setq ss (ssget '((0 . "INSERT") (2 . "`*U*,blkname") (66 . 1))))
(setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
(setq tlst
      (mapcar 'cadr
              (vl-sort tlst
                       '(lambda (a b)
                          (if (equal (caar a) (caar b) 1e-6)
                            (> (cadr (car a)) (cadr (car b)))
                            (< (car (car a)) (car (car b)))
                          )
                        )
              )
      )
)
;; after sorting points list
;; Step Thought Selection Set and update block that matches.
(repeat (length tlst)
  (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (if (eq (cdr (assoc 10 (entget blk))) (car tlst)) ;only update block that matches point.
      (progn
        (setq blk (vlax-ename->vla-object blk))
        (foreach param props
          (if (eq parafdek (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Niveau 5))
            (vla-update blk)
          )
          (if (eq parnr (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
            (vla-update blk)
          )
        )
        (setq Volgnr (1+ Volgnr))
        (setq i (1+ i))
      )
    )
  )
  (setq tlst (cdr tlst)) ;remove checked point from list.
)

 

 

[Phvl]

 

Sorry for the late response.

 

mhupp, thanks for the code. only when i run your code i get the following error code: ; error: bad argument type: lselsetp

 

(defun C:Numtest(/ Niveau blk blkname parafdek parnr SS i Volgnr tlst)
 
(setq blkname '("18" "19"))
(setq parafdek "Nivo")
(setq parnr "Volgnr")
(setq Niveau (getreal "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): "))

(setq SS (ssget '((0 . "INSERT") (2 . "`*U*,blkname") (66 . 1))))
(setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
(setq tlst
	(mapcar 'cadr
        (vl-sort tlst
			'(lambda (a b)
                (if (equal (caar a) (caar b) 1e-6)
					(> (cadr (car a)) (cadr (car b)))
                    (< (car (car a)) (car (car b)))
                )
            )
        )
    )
)
;; after sorting points list
;; Step Thought Selection Set and update block that matches.
(setq i 0)
(setq Volgnr 1)
(repeat (sslength tlst)
  (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (if (eq (cdr (assoc 10 (entget blk))) (car tlst)) ;only update block that matches point.
      (progn
        (setq blk (vlax-ename->vla-object blk))
        (foreach param props
          (if (eq parafdek (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Niveau 5))
            (vla-update blk)
          )
          (if (eq parnr (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
            (vla-update blk)
          )
        )
        (setq Volgnr (1+ Volgnr))
        (setq i (1+ i))
      )
    )
  )
  (setq tlst (cdr tlst)) ;remove checked point from list.
)
(princ)
)
(vl-load-com)

 

[mhupp]

Didn't really look at the code first time around. the ssget is wrong. if you want to use a variable with ssget you have to use cons

(setq blkname (getstring "\nEnter Block Name: ")
(setq SS (ssget (list (0 . "INSERT") (cons 2 blkname) (66 . 1))))

 

updated code with minor changes. if you keep getting nothing selected message you need to update the block names in ssget.

(defun C:Numtest (/ parafdek parnr Niveau SS tlst Volgnr)
  (setq parafdek "Nivo"
        parnr "Volgnr"
        Niveau (getint "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): ")
  )
  (if (setq SS (ssget '((0 . "INSERT")(66 . 1))))
    (progn
      (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (if (not (member (LM:effectivename (vlax-ename->vla-object obj)) '("18" "19")))
          (ssdel obj ss)
        )
      )        
      (setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
      (setq tlst
        (vl-sort tlst
          '(lambda (a b)
            (if (equal (caar a) (caar b) 1e-6)
              (> (cadr (car a)) (cadr (car b)))
              (< (car (car a)) (car (car b)))
            )
          )
        )
      )
      ;; after sorting points list
      ;; Step Thought Selection Set and update block that matches.
      (setq Volgnr 1)
      (repeat (length tlst)
        (setq blk (vlax-ename->vla-object (cadar tlst)))
        (setq props (vlax-safearray->list(variant-value(vla-getdynamicblockproperties blk))))
        (foreach param props
          (if (eq parafdek (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Niveau 5))
            (vla-update blk)
          )
          (if (eq parnr (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
            (vla-update blk)
          )
        )
        (setq Volgnr (1+ Volgnr))
        (setq tlst (cdr tlst))  ;remove checked point from list.
      )
      
    )
  (prompt "\nNothing Selected")
  )
  (princ)
)
;; Effective Block Name  -  Lee Mac
;; obj - [vla] VLA Block Reference object
(defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)

 

Edited February 17, 2022 by mhupp
code update

[Phvl]

mhupp,

 

Thanks for the explanation about a variable with ssget!

 

Now, when i run the code i get the error: error: bad argument type: consp 1

Not sure but could the ")" be the problem?

 

Quote

(setq SS (ssget '((0 . "INSERT") (2 . "`*U*18,`*U*19")) (66 . 1)))

=> (setq SS (ssget '((0 . "INSERT") (2 . "`*U*18,`*U*19") (66 . 1))))

 

Still I have troubles with the list of block names to be selected. Maybe because they are dynamic blocks and the block names are "*U..." while the effective block names are "18" , "19" , "..."?

 

 

 

[mhupp]

Updated ssget code to only look for blocks with attributes. then filers down with lee mac's function if they are not on the list removes them from the selection set.

[Phvl]

@mhupp Thank you! It's working perfectly now.

 

Just out of curiosity, is it possible to set "Volgnr" back to 1 for each block (18, 19, 20, ...)? 

[mhupp]

You would have to add the number to tlst after sorting some how with maths idk, separate them out into their own selection sets, or run them one at a time.

don't really know how to do the first one. 2nd one would take a big edit to achieve.

 

This is the third option.

(defun C:Numtest (/ parafdek parnr Niveau SS tlst Volgnr)
  (setq Niveau (getint "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): ")
        blkname (getstring t "\nBlock name: ") ;t is need if you have spaces
  )
  (if (setq SS (ssget '((0 . "INSERT"))))
    (progn
      (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (if (not (member (LM:effectivename (vlax-ename->vla-object obj)) blkname)))
          (ssdel obj ss)
        )
      )
      (setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
      (setq tlst
            (vl-sort tlst
                     '(lambda (a b)
                        (if (equal (caar a) (caar b) 1e-6)
                          (> (cadr (car a)) (cadr (car b)))
                          (< (car (car a)) (car (car b)))
                        )
                      )
            )
      )
      ;; after sorting points list
      ;; Step Thought Selection Set and update block that matches.
      (repeat (length tlst)
        (setq blk (vlax-ename->vla-object (cadar tlst)))
        (setq props (vlax-safearray->list (variant-value (vla-getdynamicblockproperties blk))))
        (foreach param props
          (if (eq "Nivo" (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Niveau 5))
            (vla-update blk)
          )
          (if (eq "Volgnr" (vla-get-propertyname param))
            (vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
            (vla-update blk)
          )
        )
        (setq Volgnr (1+ Volgnr))
        (setq tlst (cdr tlst))          ;remove checked point from list.
      )

    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

 

Edited February 17, 2022 by mhupp

[BIGAL]

I think it was over at forums/autodesk (setq SS (ssget (list (cons 0  "INSERT")(cons 2 "*U",effectivename" ))) something like that will try to find maybe by Kent Cooper.

[Phvl]

 

here's an attempt to set "Volgnr" back to 1 for each block (01, 02, ..., 20)

 

I have created a selection set for each block and then want to cycle through each selection set to sort and renumber.

 

(defun C:Numtest (/ parafdek parnr Niveau SS tlst Volgnr idx)
  (setq parafdek "Nivo"
        parnr "Volgnr"
		Blocknames '("01" "02" "03" "04" "05" "06" "07" "08" "09" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20")
        Niveau (getint "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): ")
  )
  (setq ss1 (ssadd)
		ss2 (ssadd)
		ss3 (ssadd)
		ss4 (ssadd)
		ss5 (ssadd)
		ss6 (ssadd)
		ss7 (ssadd)
		ss8 (ssadd)
		ss9 (ssadd)
		ss10 (ssadd)
		ss11 (ssadd)
		ss12 (ssadd)
		ss13 (ssadd)
		ss14 (ssadd)
		ss15 (ssadd)
		ss16 (ssadd)
		ss17 (ssadd)
		ss18 (ssadd)
		ss19 (ssadd)
		ss20 (ssadd)
  )
  (if (setq SS (ssget (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," (apply 'strcat (mapcar '(lambda (a) (strcat a ",")) Blocknames)))))))
    (progn
	  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
		(cond ((member (LM:effectivename (vlax-ename->vla-object obj)) '("01")) (ssadd obj ss1))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("02")) (ssadd obj ss2))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("03")) (ssadd obj ss3))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("04")) (ssadd obj ss4))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("05")) (ssadd obj ss5))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("06")) (ssadd obj ss6))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("07")) (ssadd obj ss7))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("08")) (ssadd obj ss8))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("09")) (ssadd obj ss9))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("10")) (ssadd obj ss10))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("11")) (ssadd obj ss11))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("12")) (ssadd obj ss12))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("13")) (ssadd obj ss13))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("14")) (ssadd obj ss14))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("15")) (ssadd obj ss15))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("16")) (ssadd obj ss16))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("17")) (ssadd obj ss17))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("18")) (ssadd obj ss18))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("19")) (ssadd obj ss19))
			  ((member (LM:effectivename (vlax-ename->vla-object obj)) '("20")) (ssadd obj ss20))
		) ;_ cond
      ) ;_ foreach
	  
	  (setq idx 1)
	  (repeat 20
		  (if (/= (read (strcat "ss" (itoa idx))) nil)
			(Progn
			  (setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (read (strcat "ss" (itoa idx))))))))
			  (setq tlst
				(vl-sort tlst
				  '(lambda (a b)
					(if (equal (caar a) (caar b) 1e-6)
					  (> (cadr (car a)) (cadr (car b)))
					  (< (car (car a)) (car (car b)))
					)
				  )
				)
			  )
			  ;; after sorting points list
			  ;; Step Thought Selection Set and update block that matches.
			  (setq Volgnr 1)
			  (repeat (length tlst)
				(setq blk (vlax-ename->vla-object (cadar tlst)))
				(setq props (vlax-safearray->list(variant-value(vla-getdynamicblockproperties blk))))
				(foreach param props
				  (if (eq parafdek (vla-get-propertyname param))
					(vlax-put-property param "Value" (vlax-make-variant Niveau 5))
					(vla-update blk)
				  )
				  (if (eq parnr (vla-get-propertyname param))
					(vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
					(vla-update blk)
				  )
				)
				(setq Volgnr (1+ Volgnr))
				(setq tlst (cdr tlst))  ;remove checked point from list.
			  )  ;_ repeat
			) ;_ progn
			(setq idx (1+ idx))
		  ) ;_ if
	  ) ;_ repeat
    ) ;_ progn
  (prompt "\nNothing Selected")
  ) ;_ if
  (princ)
)

;; Effective Block Name  -  Lee Mac
;; obj - [vla] VLA Block Reference object
(defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)

 

But it's giving me the error: "error: bad argument type: lselsetp SS1"

 

I'm not sure the selection set is named correctly in this line:

 

(setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (read (strcat "ss" (itoa idx))))))))

 

Thanks in advance for any help

[mhupp]

See if this works untested. lightly tested.

(defun C:Numtest (/ Blocknames Niveau SS SS1 blk blklst tlst Volgnr)
  (setq Blocknames '( "01" "02" "03" "04" "05" "06" "07" "08" "09" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20")
        Niveau (getint "\nGeef afdek op ( ... / -1 / 0 / 1 / 2 / ... ): ")
  )
  (if (setq SS (ssget '((0 . "INSERT") (66 . 1))))  ;main selection
    (progn
      (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (if (member (setq blk (cdr (assoc 2 (entget x)))) Blocknames)
          (if (not (member blk blklst))
            (setq blklst (cons blk blklst))  ;build a uniqe list of block names that are in ss 
          )
        )
      )
      (foreach name blklst
        (sssetfirst nil SS)
        (setq SS1 (ssget (list (cons 2 (strcat "`*U*," name)))))  ;sub selection
        (setq tlst nil) ;clear tlst for each block 
        (setq tlst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS1)))))
        (setq tlst
              (vl-sort tlst
                       '(lambda (a b)
                          (if (equal (caar a) (caar b) 1e-6)
                            (> (cadr (car a)) (cadr (car b)))
                            (< (car (car a)) (car (car b)))
                          )
                        )
              )
        )
        ;; after sorting points list
        ;; Step Thought Selection Set and update block that matches.
        (setq Volgnr 1)
        (repeat (length tlst)
          (setq blk (vlax-ename->vla-object (cadar tlst)))
          (setq props (vlax-safearray->list (variant-value (vla-getdynamicblockproperties blk))))
          (foreach param props
            (if (eq "Nivo" (vla-get-propertyname param))
              (vlax-put-property param "Value" (vlax-make-variant Niveau 5))
              (vla-update blk)
            )
            (if (eq "Volgnr" (vla-get-propertyname param))
              (vlax-put-property param "Value" (vlax-make-variant Volgnr 5))
              (vla-update blk)
            )
          )
          (setq Volgnr (1+ Volgnr))
          (setq tlst (cdr tlst))  ;remove checked point from list.
        )
      )
    )
    (prompt "\nNothing Selected")
  )
  (princ)  
)

 

Edited February 19, 2022 by mhupp
forgot "`*U*" in block name