change existing block attribute lisp

change existing block attribute lisp

mruPRQUJ
Advocate Advocate
1,644 Views
9 Replies
Message 1 of 10

change existing block attribute lisp

mruPRQUJ
Advocate
Advocate

Hi there,

The below lisp is used to modify selected block attribute.
(vl-string-subst "" "B" string),
(vl-string-subst "" "b" string),
(wcmatch attribute_string "#[AaBb]"),
(wcmatch attribute_string "##[AaBb]")
in the above setting, block attribute will be change from 1B to 1


(vl-string-subst "B" "A" string),
(vl-string-subst "b" "a" string),
(wcmatch attribute_string "#[AaBb]"),
(wcmatch attribute_string "##[AaBb]")
in the above setting, block attribute will be change from 1A to 1B

 

(vl-string-subst "" "C" string),
(vl-string-subst "" "c" string),
(wcmatch attribute_string "#[AaCc]"),
(wcmatch attribute_string "##[AaCc]")
in the above setting, block attribute will be change from 1C to 1

 

Could you please modify the lisp to change block attribute from 1 to 1C?

Please see the lisp below, the original lisp was attached as well, thank you very much in advance. 🙂

 

(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 "" "B" string)
)
(
(= (car (reverse (vl-string->list string))) 97)
(vl-string-subst "" "b" string)
)
)
)
 
  ;********************************************************************************************
 
(setq data_assoc_list '(
("DATE" . "2024MAY")
; ("DESIGNED_BY" . "P. SINGH")
; ("INDEPENDENT_CHK" . "R. CLELLAND")
; ("DRAFTED_BY" . "M. RU")
; ("DRAFTING_CHECK" . "P. SINGH")
)
)
(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,REVTRIANGLE")
(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 "#[AaBb]")
        (setq attribute_string (substr attribute_string 1 1)) ; keep only #
        (vla-put-textString attribute attribute_string)
       )
       ((wcmatch attribute_string "##[AaBb]")
        (setq attribute_string (substr attribute_string 1 2))  ; keep only ##
        (vla-put-textString attribute attribute_string)
       )       
      ) ; cond
)
)
)
)
(
(or  
(= "BCH-ST-DYN-DWG-ISSUE" (vla-get-effectivename block_reference))
(= "B-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)
)

 

 

0 Likes
Accepted solutions (1)
1,645 Views
9 Replies
Replies (9)
Message 2 of 10

paullimapa
Mentor
Mentor

for block attribute will be change from 1B to 1:

((wcmatch attribute_string "1B")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

for block attribute will be change from 1A to 1B:

((wcmatch attribute_string "1A")
 (setq attribute_string (strcat (substr attribute_string 1 1) "B")) ; keep only 1st digit & add B
 (vla-put-textString attribute attribute_string)
) 

for block attribute will be change from 1C to 1:

((wcmatch attribute_string "1C")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

you can also combine 1B to 1 & 1C to 1:

((wcmatch attribute_string "1[BC]")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 3 of 10

paullimapa
Mentor
Mentor

FYI: Since there are no wildcard matching requirements then instead of wcmatch use eq 

for block attribute will be change from 1B to 1:

((eq attribute_string "1B")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

for block attribute will be change from 1A to 1B:

((eq attribute_string "1A")
 (setq attribute_string (strcat (substr attribute_string 1 1) "B")) ; keep only 1st digit & add B
 (vla-put-textString attribute attribute_string)
) 

for block attribute will be change from 1C to 1:

((eq attribute_string "1C")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

only when combining 1B & 1C then use wcmatch:

((wcmatch attribute_string "1[BC]")
 (setq attribute_string (substr attribute_string 1 1)) ; keep only 1st digit
 (vla-put-textString attribute attribute_string)
)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 4 of 10

mruPRQUJ
Advocate
Advocate

Sorry I did not say it clearly.

1, 2, 3, or 5, 15 need to be changed to 1B, 2B, 3B, or 5B, 15B, thanks.

0 Likes
Message 5 of 10

paullimapa
Mentor
Mentor

in that case then use this:

((wcmatch attribute_string "#,##") ; single or double digit numbers
 (setq attribute_string (strcat attribute_string "B")) ; Add B
 (vla-put-textString attribute attribute_string)
)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 6 of 10

mruPRQUJ
Advocate
Advocate

could you please advise me if this will be added to the existing lisp? Or it is a new lisp.

only below block attributes need to be modified, sorry about it, thanks.

"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,REVTRIANGLE")

0 Likes
Message 7 of 10

paullimapa
Mentor
Mentor
Accepted solution

that depends because your existing lisp has these lines:

      (cond
       ((wcmatch attribute_string "#[AaBb]")
        (setq attribute_string (substr attribute_string 1 1)) ; keep only #
        (vla-put-textString attribute attribute_string)
       )
       ((wcmatch attribute_string "##[AaBb]")
        (setq attribute_string (substr attribute_string 1 2))  ; keep only ##
        (vla-put-textString attribute attribute_string)
       )       
      ) ; cond

If you think your title block attribute values could match those 2 conditions which is a single or double digit number(s) followed by either upper case A or B or lower case a or b but you don't want any changes to occur then save the current lisp with a different name and replace the above lines of code with the one I provided. Then when you run this new code only the changes you want to occur will take place.


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 8 of 10

mruPRQUJ
Advocate
Advocate

Great job! Thanks a lot! 🙂

0 Likes
Message 9 of 10

paullimapa
Mentor
Mentor

glad to have helped again...cheers!!!


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 10 of 10

mruPRQUJ
Advocate
Advocate

thanks again! cheers!!!

0 Likes