Originally Posted by
james.126519
I understand what you are saying.
I dont know much about LISP at all, so bear with me.
If I have three of the same block in a drawing, and one is 10" long, and the other two are 20" long, and I run the program to lablel them as ABC, it will name the 10" long block ABC1 and both of the 20" long blocks ABC2. At this point, the program has completed. Is there a way to add a variable or something in the program that it keeps a list of all of the parts marks it had created. Then, If i change one of the 20" blocks to 15", and re-run the program, it first consults its list to determine what part marks have been used. It would see that ABC1 (10") has been used and ABC2 (20") has been used, then determine what new blocks are within the selection set (15"), and determine that the next available number for that block is ABC3. Also, if there were already an ABC3 (15") in the drawing from the first run, and I added more of the same part, it would recognize that any new parts with the same length should match what they were part marked originally.
Hopefully I explained that correctly. Again, I dont know what is or is not possible with LISP.
While more regulations was setup, it do be possible for vlisp and of coz that will make the program little more complex. however, as for ur request, I have tried to add some comments on the routine so that you can understand the logic procedure and regulation of the new program and help ur programming skills as well. I have not got enough time and data to make adequate test. Just try it.
Code:
;|
Regulations for GlassTAG2
Once the glasses was labeled, the glass attributes will be marked automatically that any change to the attribute content
will be changed back while the routine is running. If the window's height is changed to other existing valid height, the
existing label number will be used, otherwise, new additional number will be added.
Copy the glasses will also clone the marked data as well.
Becoz every 1st time the program is running on the rough glasses and the label number system was established based on the
glasses in the section set. This can be the base group of the Label-System. Mixing the different Label-System may cause
unknown error. In order to do so, please run ClearTag2 to clear the data marks and then run GlassTag2 again.
|;
(Defun C:Glasstag2 (/ block-analysis make-unique
get-number *DD* AT BPFX
CALH II PFX SAVDAT SAVH
SAVSTR SN SS STR TAG
VBLK XXX
)
;| Analysis the block attribute, return global var *DD*, only attribute with valid TAG will be recognized.
Format of *DD*
(([Str]BlockName1
([Real]Height1 [VLO]AttributeObject1 [Str]SavedHeight1 [Str]SavedLabelString1)
([Real]Height2 [VLO]AttributeObject2 [Str]SavedHeight2 [Str]SavedLAbelString2)
...
)
([Str]BlockName2
([Real]Height1 [VLO]AttributeObject1 [Str]SavedHeight1 [Str]SavedLabelString1)
([Real]Height2 [VLO]AttributeObject2 [Str]SavedHeight2 [Str]SavedLabelString2)
...
)
)
YY: Calculated Window Height
SX: Saved Windows Height in last running, if not, use NIL
SY: Last labled Valid-and-good string
|;
(Defun block-analysis (blk tagx / BN LL SX SY UR XX YY)
(vla-getboundingbox
(setq blk (vlax-ename->vla-object blk))
'll
'ur
)
(setq bn (vla-get-effectivename blk)
ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
yy (abs (- (cadr ur) (cadr ll)))
)
(foreach at (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
(setq sx (vlax-ldata-get (vlax-vla-object->ename at) "GlassTag")
sy (vlax-ldata-get (vlax-vla-object->ename at) "ValidTag")
)
(if (member (vla-get-tagstring at) tagx) ; If the tag is valid
(if (null (setq xx (cdr (assoc bn *dd*))))
(setq *dd* (cons (list bn (list yy at sx sy)) *dd*))
; New data, added directly
(setq xx (cons (list yy at sx sy) xx)
*dd* (subst (cons bn xx) (assoc bn *dd*) *dd*)
; Existing data, update
)
)
)
)
)
;;; Remove duplicated items
(Defun make-unique (lst / abc rtn)
(foreach abc lst
(if (null (vl-position abc rtn))
(setq rtn (cons abc rtn))
)
)
(reverse rtn)
)
;;; Get the proper next useful number from existing data
(Defun get-number (lst pfx / abc rtn)
(setq rtn 0)
(foreach abc lst
(if (= (type abc) 'str)
(setq rtn (max rtn (read (vl-string-subst "" pfx abc))))
)
)
(itoa (1+ rtn))
)
;|
BPFX: Data list to save the valid Block name and relative Label prefix
VBLK: Valid Blocks
TAG: Valid Tags
|;
(setq Bpfx '(("451T-VG-570" "SM")
("451T-VG-572" "SMP")
("451T-CG-001" "M")
("NewBlockNameHere" "NewPrefixStringHere")
)
VBlk (mapcar 'car Bpfx)
Tag '("PART-MARK" "NewGlassTagHere")
ii -1
)
(princ "\n Valid blocks:")
(foreach ss VBlk
(princ (strcat ss "\t"))
)
(princ "\n Please select the Glass block(s) <Exit>:")
(if (setq ss (ssget (list (cons 0 "insert") (cons 66 1))))
(progn
(princ (strcat "\n Processing "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(repeat (sslength ss) ; Loop selected blocks 1 by 1
(if
(member (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
VBlk
)
(block-analysis sn Tag) ; Analysis only for valid block names
)
)
(foreach nn *dd*
(setq pfx (car (cdr (assoc (car nn) Bpfx)))
nn (cdr nn)
nn (vl-sort nn '(lambda (p1 p2) (< (car p1) (car p2))))
; Sort from small to large
at (mapcar 'reverse nn)
SavStr (make-unique (mapcar 'car at))
; All existing valid label string
SavDat (make-unique (mapcar 'cdr (mapcar 'cdr nn)))
; The (ValidHeight ValidString) data
) ; Format for nn ("BlockName" (HT1 AT1 SAVHT1 VALIDSTR1)(HT2 AT2 SAVHT2 VALIDSTR2)...)
(foreach at nn
; Format for mm (HTx ATx SavedHeightx SavedLabelx)
(setq CalH (rtos (nth 0 at) 2 3) ; Calculated Height
SavH (nth 2 at) ; Saved Height
str (nth 3 at) ; valid Attrribute Label, maybe not the same as the attribute's content
at (nth 1 at) ; Attribute Object
)
(cond ((= CalH SavH) ; The Calculated height and Saved height is Same
(setq xxx str)
)
((/= CalH SavH) ; The Calculated height and Saved height is not same, changed or new
(if (null (setq xxx (cdr (assoc CalH SavDat))))
(setq xxx (strcat pfx (get-number SavStr pfx))
SavStr (cons xxx SavStr)
SavDat (cons (list CalH xxx) SavDat)
; Create new ID for new height
)
(setq xxx (car xxx)) ; Using existing saved label with the proper height
)
)
)
(vla-put-textstring at xxx)
(vlax-ldata-put
(vlax-vla-object->ename at)
"GlassTag"
CalH
)
(vlax-ldata-put
(vlax-vla-object->ename at)
"ValidTag"
xxx
)
)
)
(princ "done!")
)
)
(princ)
)
(Defun C:Cleartag2 (/ block-clear BPFX II SN SS VBLK)
(Defun block-clear (blk / at)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(if (vlax-ldata-get
(setq at (vlax-vla-object->ename at))
"GlassTag"
)
(progn
(vlax-ldata-delete at "GlassTag")
(vlax-ldata-delete at "ValidTag")
)
)
)
)
(setq Bpfx '(("451T-VG-570" "SM")
("451T-VG-572" "SMP")
("451T-CG-001" "M")
("NewBlockNameHere" "NewPrefixStringHere")
)
VBlk (mapcar 'car Bpfx)
ii -1
)
(princ "\n Valid blocks:")
(foreach ss VBlk
(princ (strcat ss "\t"))
)
(princ "\n Please select the Glass block(s) <Exit>:")
(if (setq ss (ssget (list (cons 0 "insert") (cons 66 1))))
(progn
(princ (strcat "\n Processing "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(repeat (sslength ss)
(if
(member (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
VBlk
)
(block-clear sn)
)
)
)
)
(princ "done!\n")
(princ)
)
Re: Reference information from tables into blocks
Reply With Quote
