Solved: Request for a lisp to modify a block att referring a list.

smallƑish · ‎10-13-2024

Select the block, and check the attribute value of C_NO. Based on the C_NO value, make the following modifications to the SLNO attribute:

- If C_NO = R1, set SLNO to 1

- If C_NO = Y1, set SLNO to 2

- If C_NO = B1, set SLNO to 3

- If C_NO = R2, set SLNO to 4

- If C_NO = Y2, set SLNO to 5

- If C_NO = B2, set SLNO to 6

Error - If the C_NO att has any extra stuff apart from RYB and 1234567890, ignore the extra stuff and filter to the result

Error - If C_NO is empty or not valid with the above. prompt C_NO value not valid

Error - If Block doesn't have these atts prompt Block invalid

(defun c:C2S (/)
  (setq values-list '((R1 1) (Y1 2) (B1 3) (R2 4) (Y2 5) (B2 6)))
   (setq block (car (entsel "\nSelect the block: ")))
   (setpropertyvalue block "C_NO" C_NO)
  (setq SLNO (getpropertyvalue block "SLNO"))
    
  (princ "\nC_NO value not valid.")
   (princ "\nNo block selected or invalid block.")
  (princ "\nSLNO Updated Sucessfully.")  
  (princ)
)

If possible, this way I can easily modify the lisp later.

Attached block dwg file for reference

Moshe-A · ‎10-13-2024

@smallƑish hi,

check this CDATA command.

enjoy

Moshe

(defun c:cdata (/ _upcase ; local function
		  values-list ss ent val0 val1 item AcDbAttrib)

 ; anonymous function, make sure keys are upper case 
 (setq _upcase (lambda (l) (mapcar (function (lambda (itm) (cons (strcase (car itm)) (cdr itm)))) l)))
  
 (setq values-list (_upcase '(("r1" . 1) ("y1" . 2) ("b1" . 3) ("r3" . 4) ("y2" . 5) ("b4" . 6))))
  
 (if (setq ss (ssget '((0 . "insert") (2 . "cdata") (66 . 1))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (cond
    ((or
      (vl-catch-all-error-p (setq val0 (vl-catch-all-apply 'getpropertyvalue (list ent "C_NO"))))
      (vl-catch-all-error-p (setq val1 (vl-catch-all-apply 'getpropertyvalue (list ent "SLNO"))))
      (not val0) (not val1) (eq val0 "")
     )
     (prompt "\ninvalid block.")
    ); case
    ((not (wcmatch (strcase val0) "R[0-9],Y[0-9],B[0-9]"))
     (prompt "\nAttribute value contains extra stuff")
    ); case
    ( t
     (if (setq item (assoc (strcase val0) values-list))
      (foreach AcDbAttrib (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes)
       (if (eq (strcase (vla-get-tagString AcDbAttrib)) "SLNO")
        (vla-put-textString AcDbAttrib (cdr item))
       )
       (vlax-release-object AcDbAttrib) 
      ); foreach
     ); if
    ); case
   ); cond
  ); foreach
 ); if

 (princ)
); c:cdata

smallƑish · ‎10-13-2024

That works perfectly for this case, thank you so much for that.

when I take it a bigger value it's not working from R10 onwards

(setq values-list (_upcase '(("r1" . 1) ("y1" . 2) ("b1" . 3) ("r2" . 4) ("y2" . 5) ("b2" . 6)
("r3" . 7) ("y3" . 8) ("b3" . 9) ("r4" . 10) ("y4" . 11) ("b4" . 12)
("r5" . 13) ("y5" . 14) ("b5" . 15) ("r6" . 16) ("y6" . 17) ("b6" . 18)
("r7" . 19) ("y7" . 20) ("b7" . 21) ("r8" . 22) ("y8" . 23) ("b8" . 24)
("r9" . 25) ("y9" . 26) ("b9" . 27) ("r10" . 28) ("y10" . 29) ("b10" . 30)
("r11" . 31) ("y11" . 32) ("b11" . 33) ("r12" . 34) ("y12" . 35) ("b12" . 36)
("r13" . 37) ("y13" . 38) ("b13" . 39) ("r14" . 40) ("y14" . 41) ("b14" . 42)
("r15" . 43) ("y15" . 44) ("b15" . 45) ("r16" . 46) ("y16" . 47) ("b16" . 48)
("r17" . 49) ("y17" . 50) ("b17" . 51) ("r18" . 52) ("y18" . 53) ("b18" . 54)
("r19" . 55) ("y19" . 56) ("b19" . 57) ("r20" . 58) ("y20" . 59) ("b20" . 60)
("r21" . 61) ("y21" . 62) ("b21" . 63) ("r22" . 64) ("y22" . 65) ("b22" . 66)
("r23" . 67) ("y23" . 68) ("b23" . 69) ("r24" . 70) ("y24" . 71) ("b24" . 72)
("r25" . 73) ("y25" . 74) ("b25" . 75) ("r26" . 76) ("y26" . 77) ("b26" . 78)
("r27" . 79) ("y27" . 80) ("b27" . 81) ("r28" . 82) ("y28" . 83) ("b28" . 84)
("r29" . 85) ("y29" . 86) ("b29" . 87) ("r30" . 88) ("y30" . 89) ("b30" . 90)
("r31" . 91) ("y31" . 92) ("b31" . 93) ("r32" . 94) ("y32" . 95) ("b32" . 96)
("r33" . 97) ("y33" . 98) ("b33" . 99) ("r34" . 100) ("y34" . 101) ("b34" . 102)
("r35" . 103) ("y35" . 104) ("b35" . 105) ("r36" . 106) ("y36" . 107) ("b36" . 108)
("r37" . 109) ("y37" . 110) ("b37" . 111) ("r38" . 112) ("y38" . 113) ("b38" . 114)
("r39" . 115) ("y39" . 116) ("b39" . 117) ("r40" . 118) ("y40" . 119) ("b40" . 120)
("r41" . 121) ("y41" . 122) ("b41" . 123) ("r42" . 124) ("y42" . 125) ("b42" . 126)
("r43" . 127) ("y43" . 128) ("b43" . 129) ("r44" . 130) ("y44" . 131) ("b44" . 132)
("r45" . 133) ("y45" . 134) ("b45" . 135) ("r46" . 136) ("y46" . 137) ("b46" . 138)
("r47" . 139) ("y47" . 140) ("b47" . 141) ("r48" . 142) ("y48" . 143) ("b48" . 144)
("r49" . 145) ("y49" . 146) ("b49" . 147) ("r50" . 148) ("y50" . 149) ("b50" . 150)
("r51" . 151) ("y51" . 152) ("b51" . 153) ("r52" . 154) ("y52" . 155) ("b52" . 156)
("r53" . 157) ("y53" . 158) ("b53" . 159) ("r54" . 160) ("y54" . 161) ("b54" . 162)
("r55" . 163) ("y55" . 164) ("b55" . 165) ("r56" . 166) ("y56" . 167) ("b56" . 168)
("r57" . 169) ("y57" . 170) ("b57" . 171) ("r58" . 172) ("y58" . 173) ("b58" . 174)
("r59" . 175) ("y59" . 176) ("b59" . 177) ("r60" . 178) ("y60" . 179) ("b60" . 180)
)))

can you please advice?

smallƑish · ‎10-13-2024

one more request, instead of selecting blocks, Possible to apply all the blocks present in the working file?

if any error occur prompt function incomplete

else Successfully completed

ec-cad · ‎10-13-2024

Try changing this line:
((not (wcmatch (strcase val0) "R[0-9],Y[0-9],B[0-9]"))
To be:
((not (wcmatch (strcase val0) "R[0-99],Y[0-99],B[0-99]"))

Might work up to 99 ?

ECCAD

smallƑish · ‎10-13-2024

I have already tried that, but unfortunately no result.

Moshe-A · ‎10-13-2024

@smallƑish

Attached the fix

Moshe

Sea-Haven · ‎10-13-2024

Just a comment

R3 = 2x3+1 = 7

R23 = 22*3+1 = 67

So no need for the mega list as can work out any RXX similar for YXX & BXX.

Y49 = 48*3+2 = 146

B60= 60*3 = 180

komondormrex · ‎10-14-2024

hey you there,

check this another one

(defun c:cno_slno (/ index pattern_list single_insert_sset cno_slno_list slno cno_temp cno)
	(setq index 0)
	(repeat 60 (setq pattern_list (append pattern_list (list (read (strcat "r" (setq str_index (itoa (setq index (1+ index))))))
								 (read (strcat "y" str_index)) (read (strcat "b" str_index))
						   	)
					)
	   	)
	)
	(if (and (setq insert_sset (ssget "_x" '((0 . "insert") (66 . 1))))
			 (null (terpri))
		)
			(foreach insert (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex insert_sset))))
				(if (setq cno_slno_list
					 	(mapcar 'cdr (vl-sort (vl-remove-if-not '(lambda (att) (member (car att) '("C_NO" "SLNO")))
 						   					 (mapcar '(lambda (attribute) (cons (vla-get-tagstring attribute) attribute))
 						   					  		  (vlax-invoke insert 'getattributes)
 						   					 )
			 						  )
			 						 '(lambda (att_1 att_2) (< (car att_1) (car att_2)))
			 				  )
					 	)
		   			)
    					(cond
						((null (apply 'and cno_slno_list)) (princ (strcat "Invalid block - \"" (vla-get-effectivename insert) "\"\n")))
						((setq slno (vl-position (read (vla-get-textstring (car cno_slno_list))) pattern_list))
							(vla-put-textstring (cadr cno_slno_list) (itoa (1+ slno)))
							(princ (strcat "\"" (vla-get-textstring (car cno_slno_list)) "\" -> \"" (itoa (1+ slno)) "\"\n"))
						)
						((vl-some '(lambda (pattern) (wcmatch (setq cno (vla-get-textstring (car cno_slno_list)))
															  (strcat (vl-symbol-name (setq pattern_found pattern)) "*")
													 )
								   )
								   pattern_list
						 )
							(if (vl-position (read (setq cno_temp (substr cno 1 (1+ (strlen (vl-symbol-name pattern_found)))))) pattern_list)
								(while (setq slno (vl-position (read cno_temp ) pattern_list))
									(vla-put-textstring (cadr cno_slno_list) (itoa (1+ slno)))
									(vla-put-textstring (car cno_slno_list) cno_temp)
									(setq cno_temp (substr cno 1 (1+ (strlen cno_temp))))
								)
								(progn
									(vla-put-textstring (car cno_slno_list) (vl-symbol-name pattern_found))
									(vla-put-textstring (cadr cno_slno_list) (itoa (1+ (vl-position pattern_found pattern_list))))
								)
							)
							(princ (strcat "\"" cno "\" = \""
										   (vla-get-textstring (car cno_slno_list)) "\" -> \""
										   (vla-get-textstring (cadr cno_slno_list)) "\"\n"
								   )
							)
						)
						((or (= "" (setq cno (vla-get-textstring (car cno_slno_list))))
						 	 (null (setq slno (vl-position (read (vla-get-textstring (car cno_slno_list))) pattern_list)))
						 )
							(princ (strcat "Invalid C_NO - \"" cno "\"\n"))
						)
						(t (princ (strcat "Invalid C_NO - "\" (vla-get-textstring (car cno_slno_list)) "\"\n")))
					)
					(princ (strcat "Invalid block - \"" (vla-get-effectivename insert) "\"\n"))
				)
			)
	)
	(princ)
)