sort dynamic blocks

sort dynamic blocks

renanemeyer
Advocate Advocate
419 Views
5 Replies
Message 1 of 6

sort dynamic blocks

renanemeyer
Advocate
Advocate

Hello everyone on the forum.

I have this lisp that reads all blocks with the name X-TEST.
Then it places each block found under the other, according to the value of the TAG parameter.

(defun c:TEST ( / ss blkRef insPt atts att tagValue newBlkRef )
  (vl-load-com)
  (setq ss (ssget "X" '((0 . "INSERT") (66 . 1) (2 . "X-TEST")))) ; Select all "X-TEST" blocks with attributes
  
  (if (not ss)
    (princ "\nNo 'X-TEST' blocks found in the current layout.")
    (progn
      (setq insPt (getpoint "\nChoose the initial point to insert the blocks: ")) ; Insertion point
      
      (foreach blk (mapcar 'cadr (ssnamex ss))
        (setq blkRef (vlax-ename->vla-object blk)) ; Converts entity to VLA-Object
        
        ; Gets all the attributes of the block
        (setq atts (vlax-invoke blkRef 'GetAttributes))
        (foreach att atts
          (if (= (strcase (vla-get-tagstring att)) "TAG")
            (setq tagValue (vla-get-textstring att))
          )
        )

        ; Inserts a new "X-TEST" block at the specified point
        (setq newBlkRef (vla-insertblock (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point insPt) "X-TEST" 1 1 1 0))
        
        ; Assigns the value of the "TAG" attribute to the new block
        (setq atts (vlax-invoke newBlkRef 'GetAttributes))
        (foreach att atts
          (if (= (strcase (vla-get-tagstring att)) "TAG")
            (vla-put-textstring att tagValue)
          )
        )

        ; Moves the insertion point downward
        (setq insPt (list (car insPt) (- (cadr insPt) 0.375) (caddr insPt)))
      )
    )
  )
  (princ)
)

 

I've tried several ways and I can't do it, I would like it to eliminate duplicate values and put the TAG parameter in alphabetical order. 
Could anyone please help with this? I've been with no way out for days

0 Likes
Accepted solutions (1)
420 Views
5 Replies
Replies (5)
Message 2 of 6

ВeekeeCZ
Consultant
Consultant

Your dwg drawing does not contain any DYNAMIC blocks. Also your code can't work with dynamic blocks. So... do you need to work with dynamic blocks?

 

Also would you post another dwg with the desired result?

0 Likes
Message 3 of 6

renanemeyer
Advocate
Advocate

@ВeekeeCZ Thank you for your feedback and willingness to look into this. Sorry for the confusion, they are not dynamic blocks, they are just blocks (with attributes)
Below is a dwg with the blocks to be analyzed, the result that the current lisp produces and how it should be done

0 Likes
Message 4 of 6

ВeekeeCZ
Consultant
Consultant
Accepted solution

Possibly like this

 

(defun c:TEST ( / ss blkRef insPt atts att tagValue newBlkRef uniqueTags)
  (vl-load-com)
  (setq ss (ssget "X" '((0 . "INSERT") (66 . 1) (2 . "X-TEST")))) ; Select all "X-TEST" blocks with attributes
  
  (if (not ss)
    (princ "\nNo 'X-TEST' blocks found in the current layout.")
    (progn
      (setq insPt (getpoint "\nChoose the initial point to insert the blocks: ")) ; Insertion point

      (foreach blk (mapcar 'cadr (ssnamex ss))
	(setq blkRef (vlax-ename->vla-object blk)) ; Converts entity to VLA-Object
	
	
	; Gets all the attributes of the block
	(setq tagValue nil
	      atts (vlax-invoke blkRef 'GetAttributes))
	(foreach att atts
	  (if (= (strcase (vla-get-tagstring att)) "TAG")
	    (setq tagValue (vla-get-textstring att))))

	(if tagValue
	  (if (not (vl-position tagValue uniqueTags))
	    (setq uniqueTags (cons tagValue uniqueTags)))))))

  (if uniqueTags
    (progn

      (setq uniqueTags (vl-sort uniqueTags '(lambda (s1 s2) (< (atoi (substr s1 2)) (atoi (substr s2 2)))))  ;; sort by numbers
	    uniqueTags (vl-sort uniqueTags '(lambda (s1 s2) (< (substr s1 1 1) (substr s2 1 1)))))           ;; sort by initial strings

      (foreach tagValue uniqueTags
	
	; Inserts a new "X-TEST" block at the specified point
	(setq newBlkRef (vla-insertblock (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point insPt) "X-TEST" 1 1 1 0))
	
	; Assigns the value of the "TAG" attribute to the new block
	(setq atts (vlax-invoke newBlkRef 'GetAttributes))
	(foreach att atts
	  (if (= (strcase (vla-get-tagstring att)) "TAG")
	    (vla-put-textstring att tagValue)
	    )
	  )
	
	; Moves the insertion point downward
	(setq insPt (list (car insPt) (- (cadr insPt) 0.375) (caddr insPt)))
	)
      )
    )
  (princ)
  )

 

Message 5 of 6

renanemeyer
Advocate
Advocate

@ВeekeeCZ you are incredible, you solved the problem that was giving me a headache for days. Thank you very much

0 Likes
Message 6 of 6

ВeekeeCZ
Consultant
Consultant

@renanemeyer wrote:

@ВeekeeCZ you are incredible, you solved the problem that was giving me a headache for days. Thank you very much


 

Glad to help. Take the updated code -- new uniqueTags variable must be localized (or reset).

0 Likes