SSGET - Block Explode w/ Prompt to Change Layer

March 24, 2018

My goal is to have a the program explode attributed blocks with the Description attribute that has the string "VV??", "VB??", "VY??", "VD??", "VG??", "VT??", "VN??", "VP??", "V3??", "V4??". The question marks are any non-blank character.

The pic below on the left shows the “before” block, and the after shows the former block after it has been exploded and a portion of the entities set to another layer. I have to change the graphic manually since I do not think it is possible to come up with an automated solution. But I would like a prompt for the user to be able to pick the lines to be changed to a certain layer (in this case "FTG-Hndwhl", then go on to the next block that meets the criteria.

Here is the code so far (adapted from prior ronjonp code):

 (defun c:test (/ _getattvalue s)
   ;; RJP - Simple get attribute value sub .. no error checking
   (defun _getattvalue (block tag)
     (vl-some
       '(lambda (att)
         (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
        )
       (vlax-invoke block 'getattributes)
     )
   )
   ;; RJP - added (66 . 1) to filter ( attributed blocks )
   (cond       ((setq
           s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (8 . "FTG-Iso") (66 . 1)))
         )
         (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
        
               (if (and ;; If we have a value, and it does not match the filter then remove item from selection
                   (setq v (_getattvalue (vlax-ename->vla-object en) "Description"))
                   ;; vl-string-search example ( more legible IMO )
                   (vl-some '(lambda (x) (vl-string-search x (strcase v)))
                           '("VV??" "VB??" "VY??" "VD??" "VG??" "VT??" "VN??" "VP??" "V3??" "V4??")
                   )
               )
         [color=red]{explode here (I think)}[/color]
           )
  
         )
         ;; Highlight selection
         ;(sssetfirst nil s)
        )
   )
   (princ)
 )
 (vl-load-com)

The provided test drawing is not a native AutoCAD document so it is going to bark at you and make you aware of that. There are 2 blocks that meet the criteria in the test drawing.

Please let me know what you think it needs.

Greg

Test1.DWG

March 26, 2018

Not sure if it would help, but I use BURST a lot as it places layer 0 defined objects that previously displayed the properties of the layer the block was inserted on the layer they were inserted on. BURST only explodes one level while EXPLODE reduces polylines inside blocks to lines and arcs. EXPLODE even breaks down dimensions inside blocks while BURST will not.

March 26, 2018

I feel a bit dirty writing this , but here you go.

(defun c:test (/ _getattvalue s)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond	((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
 (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
   (if (and ;; If we have a value, and it does not match the filter then remove item from selection
	    (setq v (_getattvalue (vlax-ename->vla-object en) "Description"))
	    ;; vl-string-search example ( more legible IMO )
	    (vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		     '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	    )
       )
     (progn (foreach i (vlax-invoke (vlax-ename->vla-object en) 'explode)
	      (if (= "AcDbAttributeDefinition" (vla-get-objectname i))
		(vl-catch-all-apply 'vla-delete (list i))
		(entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	      )
	    )
	    (entdel en)
     )
   )
 )
 ;; Highlight selection
 ;; (sssetfirst nil s)
)
 )
 (princ)
)
(vl-load-com)

Edited March 26, 2018 by ronjonp

March 26, 2018

I feel a bit dirty writing this , but here you go.

well... a dirty mind is a joy forever

March 26, 2018

well... A dirty mind is a joy forever

lol ..........

March 26, 2018

I feel a bit dirty writing this

, but here you go.

(defun c:test (/ _getattvalue s)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
    (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond    ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and ;; If we have a value, and it does not match the filter then remove item from selection
           (setq v (_getattvalue (vlax-ename->vla-object en) "Description"))
           ;; vl-string-search example ( more legible IMO )
           (vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
                '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
           )
          )
        (progn (foreach i (vlax-invoke (vlax-ename->vla-object en) 'explode)
             (if (= "AcDbAttributeDefinition" (vla-get-objectname i))
           (vl-catch-all-apply 'vla-delete (list i))
           (entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
             )
           )
           (entdel en)
        )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
 )
 (princ)
)
(vl-load-com)

ronjonp, thanks for that (dirty or not)!

That worked pretty well, but it changed the entire block to the new layer instead of leaving it at its native layer. Only some of the polylines from the block need to go to the new layer and have the user manually pick them.

But I thought about it some more and I had another idea. After the block is exploded, can a collection be made of the “just exploded block”, whereby the user can cycle through the polylines and be prompted to change a highlighted polyline to the new layer? That might be a better solution than manually picking. I don’t know if that is possible though.

Greg

March 30, 2018

Any thoughts?

Greg

March 30, 2018

Try this .. still waaayyyy too manual IMO but... . What are you doing with this exploded information on different layers?

(defun c:test (/ _getattvalue o s ll ur)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond
   ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and	;; If we have a value, and it does not match the filter then remove item from selection
	(setq v (_getattvalue (setq o (vlax-ename->vla-object en)) "Description"))
	;; vl-string-search example ( more legible IMO )
	(vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		 '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	)
   )
 (progn
   (vlax-invoke (vlax-get-acad-object) 'zoomcenter (vlax-get o 'insertionpoint) 1)
   (foreach i (vlax-invoke o 'explode)
     (if (= "AcDbAttributeDefinition" (vla-get-objectname i))
       (vl-catch-all-apply 'vla-delete (list i))
       (progn
	 (vla-put-color i 1)
	 (vla-update i)
	 (if
	   (getpoint "\nPick a point to change red object layer or enter for no change: ")
	    (entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	 )
       )
     )
   )
   (entdel en)
 )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
 )
 (princ)
)

Edited March 30, 2018 by ronjonp

March 30, 2018

Try this .. still waaayyyy too manual IMO but... . What are you doing with this exploded information on different layers?

(defun c:test (/ _getattvalue o s ll ur)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond
   ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and	;; If we have a value, and it does not match the filter then remove item from selection
	(setq v (_getattvalue (setq o (vlax-ename->vla-object en)) "Description"))
	;; vl-string-search example ( more legible IMO )
	(vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		 '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	)
   )
 (progn
   (vla-getboundingbox o 'll 'ur)
   (vlax-invoke (vlax-get-acad-object) 'zoomcenter (vlax-get o 'insertionpoint) 1)
   (foreach i (vlax-invoke o 'explode)
     (if (= "AcDbAttributeDefinition" (vla-get-objectname i))
       (vl-catch-all-apply 'vla-delete (list i))
       (progn
	 (vla-put-color i 1)
	 (vla-update i)
	 (if
	   (getpoint "\nPick a point to change red object layer or enter for no change: ")
	    (entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	 )
       )
     )
   )
   (entdel en)
 )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
 )
 (princ)
)

I appreciate the help!

The Backstory: The client wants the symbology on different layers, so that's where this is coming from. The symbols are generated by blocks when the .dwg is created, with the granularity on the levels required by the client exceeds the capability of the program generating the data. So I am having to put together a procedure that will turn a drawing with exactly the same graphical content into one whereby it will meed the client's CAD standards.

I hope that makes some kind of sense.

Greg

March 30, 2018

Here's a quick example changing layers by a known length of object inside the block ..

(defun c:test (/ _getattvalue d blks o s v)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond
   ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and	;; If we have a value, and it does not match the filter then remove item from selection
	(setq v (_getattvalue (setq o (vlax-ename->vla-object en)) "Description"))
	;; vl-string-search example ( more legible IMO )
	(vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		 '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	)
   )
 (progn
   (vlax-for i (vla-item blks (vla-get-name o))
     (if (vlax-property-available-p i 'length)
       (progn (setq d (vla-get-length i))
	      (if (or (equal d 0.234409 1e-4) (equal d 0.146518 1e-4))
		(entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	      )
	 
       )
     )
   )
   (vla-update o)
 )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
  
 )
 (princ)
)
(vl-load-com)

March 30, 2018

Try this .. still waaayyyy too manual IMO but... . What are you doing with this exploded information on different layers?

(defun c:test (/ _getattvalue o s ll ur)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond
   ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and	;; If we have a value, and it does not match the filter then remove item from selection
	(setq v (_getattvalue (setq o (vlax-ename->vla-object en)) "Description"))
	;; vl-string-search example ( more legible IMO )
	(vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		 '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	)
   )
 (progn
   (vlax-invoke (vlax-get-acad-object) 'zoomcenter (vlax-get o 'insertionpoint) 1)
   (foreach i (vlax-invoke o 'explode)
     (if (= "AcDbAttributeDefinition" (vla-get-objectname i))
       (vl-catch-all-apply 'vla-delete (list i))
       (progn
	 (vla-put-color i 1)
	 (vla-update i)
	 (if
	   (getpoint "\nPick a point to change red object layer or enter for no change: ")
	    (entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	 )
       )
     )
   )
   (entdel en)
 )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
 )
 (princ)
)

ronjonp, it cycles through all of the elements like it is supposed to so that part is great.

But it turns everything red, whether I hit return or do a pick. So, am I doing something wrong?

Greg

March 30, 2018

Here's a quick example changing layers by a known length of object inside the block ..

(defun c:test (/ _getattvalue d blks o s v)
 ;; RJP - Simple get attribute value sub .. no error checking
 (defun _getattvalue (block tag)
   (vl-some
     '(lambda (att)
 (cond ((eq (strcase tag) (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
      )
     (vlax-invoke block 'getattributes)
   )
 )
 ;; RJP - added (66 . 1) to filter ( attributed blocks )
 (cond
   ((setq s (ssget "_C" '(7.244 2.071) '(16.665 10.003) '((0 . "INSERT") (66 . 1))))
    (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (if (and	;; If we have a value, and it does not match the filter then remove item from selection
	(setq v (_getattvalue (setq o (vlax-ename->vla-object en)) "Description"))
	;; vl-string-search example ( more legible IMO )
	(vl-some '(lambda (x) (wcmatch (strcase v) (strcat "*" x "*")))
		 '("VV" "VB" "VY" "VD" "VG" "VT" "VN" "VP" "V3" "V4")
	)
   )
 (progn
   (vlax-for i (vla-item blks (vla-get-name o))
     (if (vlax-property-available-p i 'length)
       (progn (setq d (vla-get-length i))
	      (if (or (equal d 0.234409 1e-4) (equal d 0.146518 1e-4))
		(entmod (append (entget (vlax-vla-object->ename i)) '((8 . "NewLayer"))))
	      )
	 
       )
     )
   )
   (vla-update o)
 )
      )
    )
    ;; Highlight selection
    ;; (sssetfirst nil s)
   )
  
 )
 (princ)
)
(vl-load-com)

Wow, that's cool!

The last statement with the "(vl-load-com)", is that required for visual lisp?

Greg

April 2, 2018

See THIS...........

Sign In

SSGET - Block Explode w/ Prompt to Change Layer

Recommended Posts

GregGleason

tombu

ronjonp

rlx

ronjonp

GregGleason

GregGleason

ronjonp

GregGleason

ronjonp

GregGleason

GregGleason

SLW210

Join the conversation

Tutorials

Forums

Activity