Minor changes to one existing lisp

[mruPRQUJ]

Hi,

I wonder if some minor changes can be added to the below lisp, thank you very much in advance.

1. freeze layer "$X-ANNO-REVC"

2. delete all objects "REVCLOUD"

The lisp is below, it was attached as well, 

(vl-load-com)

(defun c:ASet (/ format_date chgtxt adoc data_assoc_list ss attribute_tag attribute_string)

;********************************************************************************************

(defun format_date (/ mon date)

(setq mon '("JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" "AUG" "SEP" "OCT" "NOV" "DEC"))

(setq date (rtos (fix (getvar "cdate")) 2 0))

(strcat (substr date 1 4) (nth (1- (atoi (substr date 5 2))) mon) (substr date 7 2))

)

  ;********************************************************************************************

(defun chgtxt (string)

(cond

(

(= (car (reverse (vl-string->list string))) 65)

(vl-string-subst "" "A" string)

)

(

(= (car (reverse (vl-string->list string))) 97)

(vl-string-subst "" "a" string)

)

)

)

  ;********************************************************************************************

(setq data_assoc_list '(

("DATE" . "2023JUL30")

)

)

(if (ssget "_X" (list '(0 . "insert")))

(vlax-for block_reference (vla-get-activeSelectionSet (vla-get-activedocument (vlax-get-acad-object)))

(cond 

(

(wcmatch (strcase (vla-get-effectiveName block_reference)) "BCH-X-BORD-DXXX,BCH-X-BORD-BXXX,BCH-X-BORD-AXXX,BCH-X-BORD-REVI,BCH-X-BORD-REVI-TRIA,BCH-X-ANNO-STMP-OBSO")

(foreach attribute (vlax-invoke block_reference 'getAttributes)

(setq attribute_tag (strcase (vla-get-tagString attribute)))

(setq attribute_string (vla-get-textString attribute))

(cond

(

(setq item (assoc attribute_tag data_assoc_list))

  (vla-put-textString attribute (format_date))

  (vla-put-textString attribute (cdr item))

)

(

(wcmatch attribute_tag "REV_`#,R_NO,R_NO_D&E,R_NO_A&B,REV_NO")

      (cond

       ((wcmatch attribute_string "#[AaAa]")

        (setq attribute_string (substr attribute_string 1 1)) ; keep only #

        (vla-put-textString attribute attribute_string)

       )

       ((wcmatch attribute_string "##[AaAa]")

        (setq attribute_string (substr attribute_string 1 2))  ; keep only ##

        (vla-put-textString attribute attribute_string)

       )       

      ) ; cond

)

)

)

)

(

(= "BCH-ST-DYN-DWG-ISSUE" (vla-get-effectivename block_reference))

(setpropertyvalue (vlax-vla-object->ename block_reference) "AcDbDynBlockPropertyVisibility" "IFC - ISSUE FOR CONSTRUCTION")

)

(

t

)

)

(vlax-release-object block_reference)

)

)

(princ)

)

[paullimapa]

just replace the (princ) at the end of the code with the following:

 (vl-cmdf "_.Layer" "_F" "$X-ANNO-REVC" "") ; freeze layer "$X-ANNO-REVC"
 (if(setq ss(ssget"_X"'((8 . "REVCLOUD")))) ; delete all objects "REVCLOUD"
  (progn
   (vl-cmdf "_.Layer" "_U" "REVCLOUD" ""); make sure layer is unlocked
   (foreach item (mapcar 'cadr (ssnamex ss))  ; create list of all entities from selection set 
    (if (= 'ename (type item))(entdel item)) ; confirm is entity & delete
   ) ; foreach
  ) ; progn
 ) ; if
(princ)

[mruPRQUJ]

Hi, 

thank you very much for your quick response. I will test it tomorrow. I wonder if you can provide another option,

1. only freeze the layer 

2. only delete the objects

They can be used in different scenarios, 

thanks again 🙂

[paullimapa]

that's simple.

if you only want to freeze the layer, then just include this:

 (vl-cmdf "_.Layer" "_F" "$X-ANNO-REVC" "") ; freeze layer "$X-ANNO-REVC"
 (princ)

if you only what to delete the objects then just include this:

 (if(setq ss(ssget"_X"'((8 . "REVCLOUD")))) ; delete all objects "REVCLOUD"
  (progn
   (vl-cmdf "_.Layer" "_U" "REVCLOUD" ""); make sure layer is unlocked
   (foreach item (mapcar 'cadr (ssnamex ss))  ; create list of all entities from selection set 
    (if (= 'ename (type item))(entdel item)) ; confirm is entity & delete
   ) ; foreach
  ) ; progn
 ) ; if
 (princ)

[mruPRQUJ]

It is late today, I will test tomorrow, thank you very much from the bottom of my heart. 😀

[mruPRQUJ]

Hi,

1. "Freeze layer" works perfectly.

2. "Delete objects Revcloud" did not work, I may make a mistake, many thanks.  

[paullimapa]

share your dwg that has objects on Layer REVCLOUD that needs to be deleted for me to test

[mruPRQUJ]

Hi,

Sorry, I did not say it clearly in the beginning. The objects are REVCLOUD, not on the layer REVCLOUD, could be on any layer, thanks. 

[paullimapa]

so most likely they're just plines which will make it very difficult to filter out from other plines.

in future remind everyone to place them on unique layer so that can be easily filtered out for erasing

[mruPRQUJ]

The objects type is revcloud, please see the image below, thanks

[paullimapa]

Again share dwg with this object

[mruPRQUJ]

sorry about it, please see attached file, thanks.

[paullimapa]

just a polyline so nothing special

[mruPRQUJ]

It is weird, I opened with AutoCAD 2021 & 2023, Both of them show revcloud, please see the image below. I use AutoCAD qselect command, also select revcloud object. Could you please consider it as object type "revcloud"? thanks. 

[hmsilva]

@mruPRQUJ 

to select all revclouds

(ssget "X" '((-3 ("RevcloudProps"))))

Hope this helps,
Henrique

[paullimapa · Accepted solution]

based on @hmsilva excellent response:

 (if(setq ss(ssget "X" '((-3 ("RevcloudProps"))))) ; delete all objects "REVCLOUD"
   (foreach item (mapcar 'cadr (ssnamex ss))  ; create list of all entities from selection set 
    (if (= 'ename (type item))(entdel item)) ; confirm is entity & delete
   ) ; foreach
 ) ; if
 (princ)

this assumes all layers are unlocked for the REVCLOUD to be deleted 

[mruPRQUJ]

thanks a lot! 🙂

[hmsilva]

---

@mruPRQUJ wrote:

thanks a lot! 🙂

---

You're welcome, @mruPRQUJ 
Glad I could help

Henrique

[mruPRQUJ]

Great job! It works very well. Thanks a million. 🙂

[paullimapa]

Sure but definitely needed @hmsilva input on that one