Reference information from tables into blocks

[james.126519]

I work in the commercial glass industry, and I am looking for someone to help make my job a bit easier.

I have attached a file with an example of what I can do, and I will explain where I want to go from there.

In the drawing attached, I have four window elevations drawn. Each window elevation consists of four pieces of glass, which are represented as dynamic blocks. After I have my elevations drawn, I use EATTEXT to extract the glass sizes into a table format, which I use to order the glass.

I have to assign glass tag numbers to each piece of glass on each elevation for our field employees to use to locate where all of the glass goes when it comes bulk shipped to the jobsite in crates. So, after I create my table, I then have to start at the top of the "Glass-Tag" column and number each row 100, 101, 102, etc...

After I have the table filled in with the glass tags, I have to go to the elevations and mark the attributes to correspond with the marks I inserted in the table.

What I want to know is if there is a way a program can be written that after I fill out the tag numbers in the table, that I can have AutoCAD write those tags back to the corresponding attributes in the dynamic blocks.

I know this is possible, but I have no understanding of programming or any idea of how intense of a project that would be. I have seen this same scenario used by other companies (where they wrote their own LISP, but are not so willing to share!) :)

Is there anyone willing to help me out here?

['gile']

Hi,

It's possible to reply your request, but it's much more easy for me to do it the reverse way: first increment the attribute using the attached LISP incsuf, then extract attributes.

[james.126519]

I like that LISP, but its not exactly what I am looking for.

If i have 400 pieces of glass spread out through a job that are the same size, I want to label all of those pieces of glass with the same part mark. The reason is, if there are 400 typical sized glass units, there is no reason that our field personnel should waste time looking for piece 94 of 400, when they can grab any one of the 400 pieces to install. So, I think it still needs to be a reference back from the table where the quantites are listed.

However, i do like your program! it would be useful in other aspects of our work.

I would love to take the time to learn some programming, but the time just isnt there right now...

[irneb]

Standard AutoCAD doesn't provide a way of importing. Although if you install Express Tools, you'll have Export / Import Attribute information. Unfortunately this doesn't do dynamic block properties (like the newer Data Extraction in 2008), but that can be got at using fields. Also it only saves to a Tab delimited TXT file.
The main thing about this method is there's a HANDLE column which identifies each block with a unique serial code. This so that the import function knows which block's attribute values to change.

[james.126519]

Even using that express tool, i would have to individually type each part mark in the file I export, then re-import it correct?

[fixo]

James, can you change all glass tags manually
and then upload edited drawing again
I can imagine how it will looks like

Attached is other lisp to draw glass sizes legend table
if you need it

~'J'~

[james.126519]

James, can you change all glass tags manually
and then upload edited drawing again
I can imagine how it will looks like

Attached is other lisp to draw glass sizes legend table
if you need it

~'J'~

Here you go. I have broken it down a bit further to help explain where I am looking to go with this.

[fixo]

James, I'll try to do it tomorrow
Now is too late

~'J'~

[fixo]

Here you go. I have broken it down a bit further to help explain where I am looking to go with this.

Not solved yet, coz I was crazy busy
Still working with it now
Keep watching

~'J'~

[irneb]

Here's what I meant by the Express tool. I've modified your block to have the width & height shown as attributes instead of the MText you had - this so it exports these values as well.

The steps are (as per pages in attached):

Export Attributes
Select where to place file
Select the relevant blocks (you can select by crossing over other stuff, it will only select blocks)
Go to the folder in explorer, right-click, select Open With --> Ms Office Excel (or any other spreadsheet program will do)
In Excel, I convert to table so it's easier to sort. Select all (Ctrl+A). And click on Format as Table (select one of the format templates)
Click on the arrow next to say Height, select Sort Smallest to largest
Modify the 1st Tag value for say the 16 3/4 group.
Copy-n-paste for the rest of the group.
Do the same for the 22, 35 and 38
Save & click Yes when told you're going to lose formatting
In AutoCAD, import
Select the file
And viola!So most of your work is in Excel, where it's basically much easier to do these type of changes.
This is probably a very simple example. If you've got much more glazing panels to sort out, you may want to look at formulas to have Excel calculate this itself. You're going to use one of the VLookUp formulas or a derivative thereof.

[james.126519]

could you attach the block how you modified it to show the width/height attributes? I know what you mean, but for some reason I can not get it to work for me. the attributes never change when I updatefield, regen, regenall, etc.

[irneb]

Sorry, I forgot one of the steps for this.

Just after you've BlockEdited the block to add / edit attributes, you need to synchronize the existing block references to the new definition using ATTSYNC or BATTMAN.

[james.126519]

Can you tell me why i get an error that says "invalid field code" when I try to set an attribute field to read the blockplaceholder the same way you did?

Sorry, I forgot one of the steps for this.

Just after you've BlockEdited the block to add / edit attributes, you need to synchronize the existing block references to the new definition using ATTSYNC or BATTMAN.

[irneb]

Can you tell me why i get an error that says "invalid field code" when I try to set an attribute field to read the blockplaceholder the same way you did?I'm really not sure, maybe it's something to do with 2007 ... I was using 2008.

[fixo]

I sent message 3 hours ago but I don't see it here
Perhaps, some problems with forum site
Give that a try
Select blocks, say by window or so, then select table

(defun get-table-content (/ atable col cols data datum row rows sset
start tmp)
(prompt "\n\t>>>\tSelect table\t>>>\n")
(setq sset (ssget "_:S" '((0 . "ACAD_TABLE"))))
(setq atable (vlax-ename->vla-object (ssname sset 0))
cols (vla-get-columns atable)
rows (vla-get-rows atable)
start rows
)
(if (eq :vlax-false (vla-get-titlesuppressed atable))
(setq rows (1- rows))
)
(if (eq :vlax-false (vla-get-headersuppressed atable))
(setq rows (1- rows))
)
(setq row (- start rows))
(repeat rows
(setq col 0)
(repeat cols
(setq datum (vla-gettext atable row col))
(setq tmp (cons datum tmp))
(setq col (1+ col))
)
(setq data (cons (reverse tmp) data)
tmp nil
row (1+ row)
)
)
(reverse data)
)


(defun C:GLS (/ adoc atts axss len maxpt minpt pt1 pt2 ss table_data value wid)

(or (vl-load-com))
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq ss (ssget (list (cons 0 "INSERT"))))
(setq axss (vla-get-activeselectionset adoc))
(setq table_data (get-table-content))
(vlax-for obj axss

(vl-catch-all-apply
'vla-getboundingbox
(list obj
'minpt
'maxpt
)
)
(setq pt1 (vlax-safearray->list minpt)
pt2 (vlax-safearray->list maxpt)
)
(setq wid (vl-princ-to-string (- (car pt2)(car pt1))))
(setq len (vl-princ-to-string (- (cadr pt2)(cadr pt1))))
(setq value (last (car (vl-remove-if-not (function (lambda(x)
(and (equal (distof len 2) (distof (cadr x) 2))
(equal (distof wid 2) (distof (caddr x) 2)))))
table_data
)
)
)
)

(setq atts (vlax-invoke obj 'Getattributes))
(foreach att atts
(if (eq (strcase "GLASS-TAG") (strcase (vla-get-tagstring att)))
(vla-put-textstring att value))))
(princ)
)
(princ "\n Start with command GLS")
(princ)
(vl-load-com)

~'J'~

[james.126519]

that works perfect on the file I had uploaded for an example!

but, I have since changed a few things about the actual glass block, and when I use the new blocks the GLS.lsp does not work. Is the program written to that specific block?

It keeps giving me an error that says "; error: ActiveX Server returned an error: Parameter not optional"

I sent message 3 hours ago but I don't see it here
Perhaps, some problems with forum site
Give that a try
Select blocks, say by window or so, then select table

(defun get-table-content (/ atable col cols data datum row rows sset
start tmp)
(prompt "\n\t>>>\tSelect table\t>>>\n")
(setq sset (ssget "_:S" '((0 . "ACAD_TABLE"))))
(setq atable (vlax-ename->vla-object (ssname sset 0))
cols (vla-get-columns atable)
rows (vla-get-rows atable)
start rows
)
(if (eq :vlax-false (vla-get-titlesuppressed atable))
(setq rows (1- rows))
)
(if (eq :vlax-false (vla-get-headersuppressed atable))
(setq rows (1- rows))
)
(setq row (- start rows))
(repeat rows
(setq col 0)
(repeat cols
(setq datum (vla-gettext atable row col))
(setq tmp (cons datum tmp))
(setq col (1+ col))
)
(setq data (cons (reverse tmp) data)
tmp nil
row (1+ row)
)
)
(reverse data)
)


(defun C:GLS (/ adoc atts axss len maxpt minpt pt1 pt2 ss table_data value wid)

(or (vl-load-com))
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq ss (ssget (list (cons 0 "INSERT"))))
(setq axss (vla-get-activeselectionset adoc))
(setq table_data (get-table-content))
(vlax-for obj axss

(vl-catch-all-apply
'vla-getboundingbox
(list obj
'minpt
'maxpt
)
)
(setq pt1 (vlax-safearray->list minpt)
pt2 (vlax-safearray->list maxpt)
)
(setq wid (vl-princ-to-string (- (car pt2)(car pt1))))
(setq len (vl-princ-to-string (- (cadr pt2)(cadr pt1))))
(setq value (last (car (vl-remove-if-not (function (lambda(x)
(and (equal (distof len 2) (distof (cadr x) 2))
(equal (distof wid 2) (distof (caddr x) 2)))))
table_data
)
)
)
)

(setq atts (vlax-invoke obj 'Getattributes))
(foreach att atts
(if (eq (strcase "GLASS-TAG") (strcase (vla-get-tagstring att)))
(vla-put-textstring att value))))
(princ)
)
(princ "\n Start with command GLS")
(princ)
(vl-load-com)

~'J'~

[fixo]

James, I need to sniff this changed block
otherwise I can't to help
My crystal ball is not working :)
Attach 'em please

~'J'~

[james.126519]

LOL, sorry about that. I have attached the new block.

Can you tell me what I can and can not change about these blocks so that the program will not be affected?

[james.126519]

I think I may have figured out the problem. When I create the table using EATTEXT, does my Glass-Tag column need to be the very last column?

[fixo]

Try this instead
What about you can not to doing
Just in my opinion only you need to avoid to
use text (in your case it is "?GL?") in blocks at all
Better yet to use attribute instead
And also I like to use attribute promts equivalent
to attribute tags

~'J'~

[james.126519]

It works great.

One thing that is odd about it is it will not work with sheet sets. If i run EATTEXT across a number of drawing files, then paste the table into each file and try to use your GLS command, it gives me the AciveX error I reported earlier. I think I have taken enough of your time, unless you know of an easy fix for this? If not, I can deal with it no problem.

[fixo]

James, I'll ry but no warranty
See you tomorrow

~'J'~

[kozmosovia]

I do not know why u want to use TABLE to make the modification. Correct me if I m wrong. what u need to do is just to re-label the glass with different numbers by different glass sizes. According with such requirement, the procedure can be totally done by program, no Table is needed. If the label number (such as 100, 101, 102...) is irelevent to other existing label numbers, which means u can define the numbers freely, then the attached program will lable the glasses automatically from 100, what u need to do is just select the glass blocks. If u want to set the proper number with the proper glass size (maybe that is the standard of the compnay), just try to make a definition to the variable CHK in the program. Then the selected glasses will be be labled as u wish.

(Defun block-analysis (blk bname / ll ur xx yy at rtn)
(if (and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
)
(progn
(vla-getboundingbox blk 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
rtn (list (strcat xx "#" yy)
(car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
)
)
rtn
)
(Defun c:test (/ ii ss sn dd data at p1 p2 val chk tag)
(if (and (setq ii -1
ss (princ "\n Please select Glass block <Exit>:")
ss (ssget (list (cons 0 "insert") (cons 66 1)))
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "True Glass Size"))
(setq data (cons dd data))
)
)
;|(setq CHK '(("GlassWidth1#GlassHeight1" "LabelNumber1")
("GlassWidth2#GlassHeight2" "LabelNumber2")
.....
)
)
(setq CHK '(("22.750#35.750" "100)("22.750#16.750" "102")......)) Add ur own
|;
(setq ii (+ 99 (length chk))
data (vl-sort data '(lambda (p1 p2) (< (car p1) (car p2))))
)
(foreach at data
(setq tag (car at)
at (cadr at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq val (itoa (setq ii (1+ ii)))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

Try TEST after loading the program

[james.126519]

What if I have more than one glass block, and I want to assign 1### to block A, 2### to block B, 3### to block C, etc? How can I modify the program to work that way? If i can do that on an as needed basis, I think this will be perfect. I have uploaded an example.

I do not know why u want to use TABLE to make the modification. Correct me if I m wrong. what u need to do is just to re-label the glass with different numbers by different glass sizes. According with such requirement, the procedure can be totally done by program, no Table is needed. If the label number (such as 100, 101, 102...) is irelevent to other existing label numbers, which means u can define the numbers freely, then the attached program will lable the glasses automatically from 100, what u need to do is just select the glass blocks. If u want to set the proper number with the proper glass size (maybe that is the standard of the compnay), just try to make a definition to the variable CHK in the program. Then the selected glasses will be be labled as u wish.

(Defun block-analysis (blk bname / ll ur xx yy at rtn)
(if (and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
)
(progn
(vla-getboundingbox blk 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
rtn (list (strcat xx "#" yy)
(car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
)
)
rtn
)
(Defun c:test (/ ii ss sn dd data at p1 p2 val chk tag)
(if (and (setq ii -1
ss (princ "\n Please select Glass block <Exit>:")
ss (ssget (list (cons 0 "insert") (cons 66 1)))
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "True Glass Size"))
(setq data (cons dd data))
)
)
;|(setq CHK '(("GlassWidth1#GlassHeight1" "LabelNumber1")
("GlassWidth2#GlassHeight2" "LabelNumber2")
.....
)
)
(setq CHK '(("22.750#35.750" "100)("22.750#16.750" "102")......)) Add ur own
|;
(setq ii (+ 99 (length chk))
data (vl-sort data '(lambda (p1 p2) (< (car p1) (car p2))))
)
(foreach at data
(setq tag (car at)
at (cadr at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq val (itoa (setq ii (1+ ii)))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

Try TEST after loading the program

[kozmosovia]

That is very simple and easy to do. Just add the blockname into the data.
Try modified program

(Defun block-analysis (blk bname / ll ur xx yy at rtn)
(if (and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
)
(progn
(vla-getboundingbox blk 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
rtn (list (strcat (strcase bname) "^" xx "#" yy)
(car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
)
)
rtn
)
(Defun c:test (/ ii ss sn data at p1 p2 val chk tag nn vblk)
;|
(setq
CHK '(("BlockRealName1^GlassWidth1#GlassHeight1" . "LabelNumber1")
("BlockRealName2^GlassWidth2#GlassHeight2" . "LabelNumber2")
(. . . . .)
)
)
Following is example, Modify it to ur purpose and enable it in program, all block name use upper letters
(setq CHK '(("GL1 (0.375 BITE)^22.750#35.750" . "100")
("GL1 (0.375 BITE)^22.750#16.750" . "101")
("GL2 (0.375 BITE)^22.750#35.750" . "200")
("GL2 (0.375 BITE)^22.750#16.750" . "201")
("GL3 (0.375 BITE)^22.750#35.750" . "300")
("GL3 (0.375 BITE)^22.750#16.750" . "301")
)
)
If the glass size is not defined, the new lable will start from 10000
|;
(if chk
(foreach ss (mapcar 'car chk)
(setq ss (substr ss 1 (vl-string-search "^" ss)))
(if (null (member ss vblk))
(setq vblk (cons ss vblk))
)
)
)
(if (and (setq ii -1
ss (princ "\n Please select Glass block(s) <Exit>:")
ss (ssget (list (cons 0 "insert") (cons 66 1)))
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii)))
nn (strcase (vla-get-effectivename (vlax-ename->vla-object sn))
)
)
(if (or (member nn vblk) (null vblk))
(setq data (cons (block-analysis sn nn) data))
)
)
(setq ii 9999
data (vl-sort data '(lambda (p1 p2) (< (car p1) (car p2))))
)
(foreach at data
(setq tag (car at)
at (cadr at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq val (itoa (setq ii (1+ ii)))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

[james.126519]

how about if I dont define glass sizes. I could have any number of an infinite selection of glass sizes, so programming it that way is not feasable. Can the program automatically assign 1000 series to GL1, 2000 series to GL2, etc.?

That is very simple and easy to do. Just add the blockname into the data.
Try modified program

(Defun block-analysis (blk bname / ll ur xx yy at rtn)
(if (and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
)
(progn
(vla-getboundingbox blk 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
rtn (list (strcat (strcase bname) "^" xx "#" yy)
(car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
)
)
rtn
)
(Defun c:test (/ ii ss sn data at p1 p2 val chk tag nn vblk)
;|
(setq
CHK '(("BlockRealName1^GlassWidth1#GlassHeight1" . "LabelNumber1")
("BlockRealName2^GlassWidth2#GlassHeight2" . "LabelNumber2")
(. . . . .)
)
)
Following is example, Modify it to ur purpose and enable it in program, all block name use upper letters
(setq CHK '(("GL1 (0.375 BITE)^22.750#35.750" . "100")
("GL1 (0.375 BITE)^22.750#16.750" . "101")
("GL2 (0.375 BITE)^22.750#35.750" . "200")
("GL2 (0.375 BITE)^22.750#16.750" . "201")
("GL3 (0.375 BITE)^22.750#35.750" . "300")
("GL3 (0.375 BITE)^22.750#16.750" . "301")
)
)
If the glass size is not defined, the new lable will start from 10000
|;
(if chk
(foreach ss (mapcar 'car chk)
(setq ss (substr ss 1 (vl-string-search "^" ss)))
(if (null (member ss vblk))
(setq vblk (cons ss vblk))
)
)
)
(if (and (setq ii -1
ss (princ "\n Please select Glass block(s) <Exit>:")
ss (ssget (list (cons 0 "insert") (cons 66 1)))
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii)))
nn (strcase (vla-get-effectivename (vlax-ename->vla-object sn))
)
)
(if (or (member nn vblk) (null vblk))
(setq data (cons (block-analysis sn nn) data))
)
)
(setq ii 9999
data (vl-sort data '(lambda (p1 p2) (< (car p1) (car p2))))
)
(foreach at data
(setq tag (car at)
at (cadr at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq val (itoa (setq ii (1+ ii)))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

[kozmosovia]

Yes, that is possible. But you should provide more detail information on how u define GL1 and GL2 series.

[james.126519]

Yes, that is possible. But you should provide more detail information on how u define GL1 and GL2 series.

For example, If you could write it so that

Block Name: "GL1 (0.375 GLASS BITE)" will start at 1000, and number up through 1999

Block Name: "GL2 (0.375 GLASS BITE)" will start at 2000 and number up through 2999

If you could omit any code to assign specific numbers to specific glass sizes, then I 'should' be able to look at the code and understand how to modify it to add block names and what numbers to assign them.

I really appreciate all of your help.

[kozmosovia]

Could u please provide me a table for all glass size and label numbers (eg: 1002: GL1 22.75x35.75, 2003: GL2 35.75x35.75), then I can attached them in the program. Then u need not run the risks on modifying the codes.

[james.126519]

I cant provide a table for glass sizes. the range of glass sizes that are possible is endless.

I basically need the program to run the exact same way your first program did, but I need to be able to add block names into the program and assign a set of values to those block names to fill in the Glass-Mark attribute.

For instance, if i have three GL1 blocks at 12" x 18", 24"x36", and 36" x 48" and I have three GL2 blocks at the same dimensions (the block properties will be exactly the same except for the block name), i want the program to label the GL1 blocks as "100", "101", and "102 respectively, and name the GL2 blocks "200", "201", and "202 respectively. I dont want the progam to assign any specific value (such as "100") to any specific size (such as 12"x18"). I apolagize if I have confused you.

Could u please provide me a table for all glass size and label numbers (eg: 1002: GL1 22.75x35.75, 2003: GL2 35.75x35.75), then I can attached them in the program. Then u need not run the risks on modifying the codes.

[kozmosovia]

Here u r the modified program. You can then add extra block names and glass tag strings in the program to make the routine useful for all ur various blocks.

;;; Labeling Glasses
(Defun C:LGlass (/ block-analysis BDAT BVAL DATA
GSIZ II NN NUM SN SS
TAG VBLK XX
)
(Defun block-analysis (blk tagx / at ll ur xx yy at rtn)
(vla-getboundingbox
(setq blk (vlax-ename->vla-object blk))
'll
'ur
)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
)
(foreach at (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
(if (member (vla-get-tagstring at) tagx)
(setq rtn (list (strcat xx "#" yy) at))
)
)
rtn
)

(setq BVal '(("GL-1" 100)
("GL-2" 200)
("NewBlockNameHere" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-analysis sn Tag))
(if (null (member (car xx) GSiz))
(setq GSiz (cons (car xx) GSiz))
)
(if (null (setq data (cdr (assoc nn BDat))))
(setq BDat (cons (list nn xx) BDat))
(setq BDat (subst (cons nn (cons xx data))
(assoc nn BDat)
BDat
)
)
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(foreach bn BVal
(setq num (cadr bn)
bn (car bn)
)
(foreach at (cdr (assoc bn BDat))
(vla-put-textstring
(cadr at)
(itoa (+ num (vl-position (car at) GSiz)))
)
)
)
(princ "done!")
)
)
(princ)
)

[james.126519]

Can you look at the attached drawing? I dont know why, but the program tagged two different sized GL1 blocks with the same tag.

Here u r the modified program. You can then add extra block names and glass tag strings in the program to make the routine useful for all ur various blocks.

;;; Labeling Glasses
(Defun C:LGlass (/ block-analysis BDAT BVAL DATA
GSIZ II NN NUM SN SS
TAG VBLK XX
)
(Defun block-analysis (blk tagx / at ll ur xx yy at rtn)
(vla-getboundingbox
(setq blk (vlax-ename->vla-object blk))
'll
'ur
)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (rtos (abs (- (car ur) (car ll))) 2 3)
yy (rtos (abs (- (cadr ur) (cadr ll))) 2 3)
)
(foreach at (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
(if (member (vla-get-tagstring at) tagx)
(setq rtn (list (strcat xx "#" yy) at))
)
)
rtn
)

(setq BVal '(("GL-1" 100)
("GL-2" 200)
("NewBlockNameHere" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-analysis sn Tag))
(if (null (member (car xx) GSiz))
(setq GSiz (cons (car xx) GSiz))
)
(if (null (setq data (cdr (assoc nn BDat))))
(setq BDat (cons (list nn xx) BDat))
(setq BDat (subst (cons nn (cons xx data))
(assoc nn BDat)
BDat
)
)
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(foreach bn BVal
(setq num (cadr bn)
bn (car bn)
)
(foreach at (cdr (assoc bn BDat))
(vla-put-textstring
(cadr at)
(itoa (+ num (vl-position (car at) GSiz)))
)
)
)
(princ "done!")
)
)
(princ)
)

[kozmosovia]

Seemed it is a bug for AutoCAD to calculate the bounding box for the glass size, but I noticed that ur glass block has another two attributes: Height and Width and that will show exactly the correct number. Then I modify the program to use these two attributes and now it work fine,

;;; Labeling Glasses
;;; All glass blocks should have two attribute tags: HEIGHT and WIDTH
(Defun C:LGlass (/ block-analysis BDAT BVAL DATA
GSIZ II NN NUM SN SS
TAG VBLK XX
)
(Defun block-analysis (blk tagx / at ll ur xx yy at att)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(cond ((= (vla-get-tagstring at) "WIDTH")
(setq xx (vla-get-textstring at))
)
((= (vla-get-tagstring at) "HEIGHT")
(setq yy (vla-get-textstring at))
)
((member (vla-get-tagstring at) tagx) (setq att at))
)
)
(if (and xx yy att)
(list (strcat xx yy) att)
nil
)
)

(setq BVal '(("GL-1" 100)
("GL-2" 200)
("NewBlockNameHere" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-analysis sn Tag))
(if (null (member (car xx) GSiz))
(setq GSiz (cons (car xx) GSiz))
)
(if (null (setq data (cdr (assoc nn BDat))))
(setq BDat (cons (list nn xx) BDat))
(setq BDat (subst (cons nn (cons xx data))
(assoc nn BDat)
BDat
)
)
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(foreach bn BVal
(setq num (cadr bn)
bn (car bn)
)
(foreach at (cdr (assoc bn BDat))
(vla-put-textstring
(cadr at)
(itoa (+ num (vl-position (car at) GSiz)))
)
)
)
(princ "done!")
)
)
(princ)
)

[james.126519]

Wonderful.

You are a life saver! I cant thank you enough. I owe you one (though I doubt there is anything CAD related that I know more about than you do).

Seemed it is a bug for AutoCAD to calculate the bounding box for the glass size, but I noticed that ur glass block has another two attributes: Height and Width and that will show exactly the correct number. Then I modify the program to use these two attributes and now it work fine,

;;; Labeling Glasses
;;; All glass blocks should have two attribute tags: HEIGHT and WIDTH
(Defun C:LGlass (/ block-analysis BDAT BVAL DATA
GSIZ II NN NUM SN SS
TAG VBLK XX
)
(Defun block-analysis (blk tagx / at ll ur xx yy at att)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(cond ((= (vla-get-tagstring at) "WIDTH")
(setq xx (vla-get-textstring at))
)
((= (vla-get-tagstring at) "HEIGHT")
(setq yy (vla-get-textstring at))
)
((member (vla-get-tagstring at) tagx) (setq att at))
)
)
(if (and xx yy att)
(list (strcat xx yy) att)
nil
)
)

(setq BVal '(("GL-1" 100)
("GL-2" 200)
("NewBlockNameHere" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-analysis sn Tag))
(if (null (member (car xx) GSiz))
(setq GSiz (cons (car xx) GSiz))
)
(if (null (setq data (cdr (assoc nn BDat))))
(setq BDat (cons (list nn xx) BDat))
(setq BDat (subst (cons nn (cons xx data))
(assoc nn BDat)
BDat
)
)
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(foreach bn BVal
(setq num (cadr bn)
bn (car bn)
)
(foreach at (cdr (assoc bn BDat))
(vla-put-textstring
(cadr at)
(itoa (+ num (vl-position (car at) GSiz)))
)
)
)
(princ "done!")
)
)
(princ)
)

[kozmosovia]

u r welcome.

[james.126519]

Now I want to somewhat roll this LISP into another use. Instead of determining the length and width of an object, I only want to determine the length, and identify each block with a part mark the same as before with the glass. Can somone show me how to modify the code to do this?

[kozmosovia]

Now I want to somewhat roll this LISP into another use. Instead of determining the length and width of an object, I only want to determine the length, and identify each block with a part mark the same as before with the glass. Can somone show me how to modify the code to do this?

Seemed not a small change will be made in order to acomplish ur goal. Anyway, here u have the routine which will do ur purpose.


(Defun C:Glasstag2 (/ block-analysis *DD* BPFX IDX
II NUM PFX SN SS TAG
VBLK YY
)
(Defun block-analysis (blk tagx / BN LL 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))
)
(if (member (vla-get-tagstring at) tagx)
(if (null (setq xx (cdr (assoc bn *dd*))))
(setq *dd* (cons (list bn (list yy at)) *dd*))
(setq xx (cons (list yy at) xx)
*dd* (subst (cons bn xx) (assoc bn *dd*) *dd*)
)
)
)
)
)

(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)
(if
(member (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
VBlk
)
(block-analysis sn Tag)
)
)
(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))))
num 0
idx nil
)
(foreach at nn
(setq yy (car at)
at (cadr at)
)
(if (null (member yy idx))
(setq idx (cons yy idx)
num (1+ num)
)
)
(vla-put-textstring
at
(strcat pfx (itoa num))
)
)
)
(princ "done!")
)
)
(princ)
)

[james.126519]

that is great. I spent hours last night researching and trying to modify it myself but no luck lol. I really am trying to learn LISP.

I have another question for you. I might have 20 different blocks, each one I will add into the program you wrote and assign a unique identification tag to it. In a drawing I might have 300 different lengths of each block. So, i run the program and extract all of the part marks generated and create my bill of materials. now, if I have to change the size of a couple of pieces, and i re-run the program, It might assign totally different part marks to all of the parts because I added a new size in the middle of the list somewhere, so that will bump up all of the part marks above it in the list. Is there a way to have the program retain the list and only add on where it left off if I add/change blocks in the drawing?

[kozmosovia]

I guess that is possible, but still, some more regulation is needed to define the situation. as u know, the glasses were sorted by their height from 1 and plus 1 for each difference. So, while a new height was added in the middle of the heights, all glasses with a larger height than that one will have to change their ID becoz the new height need a number position. Or as what i guess, that if a new height was created, we have to keep all existing labels not changed and just create a new number position for the new hight. is that right?

But it is hard to define the change, for example, your existing data was 10 for "M1" and only 2 glasses with height of 10, while u change one of them the height to 11. If the exisiting largest number for all certain glasses was "M5", so it is hard for program to determine to change the 1 glass with height 10 to "M6" or 11 to "M6". And I hope u understand what i mean. so additional regulations should be provided to help the program to determine the exactly changed glasses and relabel them.

[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.

[kozmosovia]

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.

;|
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)
)

[james.126519]

That code works perfect!

I do need to understand one thing though. I am constantly modifying blocks to perform different tasks. The blocks that were in the drawing I sent you had two linear paramaters, one to stretch the length of the rectangle, and the other to move the attribute. The code worked great with those blocks. then I realized I needed to change the second linear paramater to a point paramater so i was not restricted to move the attribute in one direction. When I did that, the program started reading the point paramater and assigning tags to the X-position rather than the linear paramter length. Can i rename the linear parameter "distance" to "Extruded Part Length" or something unique so that no matter what I change in the block, as long as that paramater is present the program will read only that paramater? I have attached what I did, as well as my modified code with the block names.

;|
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:JHUPartMark (/ 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 '(("450-CG-028 POCKET FILLER" "CPF")
("400-026 FLAT FILLER" "FF")
("400-075 CORNER POST" "CP")
("400-028 SILL FLASHING" "SF")
("450-CG-002 POCKET FILLER" "PF")
("400-011 TUBE HORIZONTAL" "H")
("400-003 SILL" "S")
("400-001 MULLION" "M")
("400-004 GLASS STOP" "GS")
)
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 DATx)
(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:JHUClearPartMark (/ 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 '(("450-CG-028 POCKET FILLER" "CPF")
("400-026 FLAT FILLER" "FF")
("400-075 CORNER POST" "CP")
("400-028 SILL FLASHING" "SF")
("450-CG-002 POCKET FILLER" "PF")
("400-011 TUBE HORIZONTAL" "H")
("400-003 SILL" "S")
("400-001 MULLION" "M")
("400-004 GLASS STOP" "GS")
)
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)
)

[kozmosovia]

U need not try to make such modification on ur dynamic blocks, in fact, as u formerly just provide the DWG with glasses all stand there and can only be stretched along the Y direction, so the program ignore other situations such as u rotate the block for 90 or 270 degree and then u can stretch the glass in X direction. As what u want to gain i guess, it to let the program determine exactly the situation that if change on X or Y direction should be record.
I have modifyed the sub function BLOCK-ANALYSIS, new function will go to see the rotation of block to determine if X direction change should be used. Use it to replace the old sub-function and try to see if you can get what u want.

(Defun block-analysis (blk tagx / BN LL ROT SX SY UR XX YY)
(vla-getboundingbox
(setq blk (vlax-ename->vla-object blk))
'll
'ur
)
(setq bn (vla-get-effectivename blk)
rot (vla-get-rotation blk)
ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (abs (- (car ur) (car ll)))
yy (abs (- (cadr ur) (cadr ll)))
)
(if(or (equal rot (* 0.5 pi) 0.001)
(equal rot (* 1.5 pi) 0.001)
)
(setq yy xx)
)
(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
)
)
)
)
)

[james.126519]

U need not try to make such modification on ur dynamic blocks, in fact, as u formerly just provide the DWG with glasses all stand there and can only be stretched along the Y direction, so the program ignore other situations such as u rotate the block for 90 or 270 degree and then u can stretch the glass in X direction. As what u want to gain i guess, it to let the program determine exactly the situation that if change on X or Y direction should be record.
I have modifyed the sub function BLOCK-ANALYSIS, new function will go to see the rotation of block to determine if X direction change should be used. Use it to replace the old sub-function and try to see if you can get what u want.

(Defun block-analysis (blk tagx / BN LL ROT SX SY UR XX YY)
(vla-getboundingbox
(setq blk (vlax-ename->vla-object blk))
'll
'ur
)
(setq bn (vla-get-effectivename blk)
rot (vla-get-rotation blk)
ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
xx (abs (- (car ur) (car ll)))
yy (abs (- (cadr ur) (cadr ll)))
)
(if(or (equal rot (* 0.5 pi) 0.001)
(equal rot (* 1.5 pi) 0.001)
)
(setq yy xx)
)
(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
)
)
)
)
)


that appears to have done the trick. Thank you very much!

[j_minola]

Chris. Are you in Commercial glass or Residental. Per some of your drawings it appears that you are in the Commercial field. If so I am also in that same field. Commercial storefront and CurtainWall. Vistawall, U.S.aluminum, Cascade, etc... Maybe we can partner up and exchange templates and blocks to make our life easier when doing shop drawings or details etc... Let me know what you think. For glass sizes we use an excel sheet that automatically adds the correct measurment to our D.L.O dimension.

[jmcbride.161140]

Hello and great thread!

I have been trying to get this code to work for me, but alas my knowledge is far below the programming going on here. I get the jist of it but cannot change the code to work with blocks I have created.

I can get it to work with both original files, but was wondering if there is a way to make some changes?

I propose the filter not be size but the location. i.e. from left to right, bottom to top.

attached is a drawing that I would like to re-number the attributes.


Any help in understanding what is going on here (programming wise) and how to make edits is HUGELY appreciated!

[kozmosovia]

Try the program

(Defun c:test (/ block-analysis ii ss sn dd data at p1 p2 val chk tag)
(Defun block-analysis (blk bname / att dat x v)
(if
(and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
(equal (vlax-get-property blk "IsDynamicBlock") :vlax-true)
(setq att (car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
(setq dat (vl-remove-if
'null
(mapcar
'(lambda (x)
(if (setq v (vlax-variant-value (vla-get-value x)))
(cons (vla-get-propertyname x)
(if (= (type v) 'safearray)
(vlax-safearray->list v)
v
)
)
)
)
(vlax-safearray->list
(vlax-variant-value
(vla-getdynamicblockproperties blk)
)
)
)
)
x (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint blk))
)
dat (list (car x)
(cadr x)
(strcat (rtos (abs (cdr (assoc "Distance" dat))) 2 4)
"#"
(rtos (abs (cdr (assoc "Distance1" dat))) 2 4)
)
att
)
)
)
dat
)
(vl-load-com)
(if (and (setq ii -1
ss (princ "\n Please select block(s) <Exit>:")
ss (ssget (list (cons 0 "insert")
(cons 66 1)
)
)
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "2400 ACM PANEL 1"))
(setq data (cons dd data))
)
)
(setq ii 99
data
(vl-sort
data
'(lambda (p1 p2)
(if (/= (car p1) (car p2))
(< (car p1) (car p2))
(if (/= (cadr p1) (cadr p2))
(< (cadr p1) (cadr p2))
(< (nth 2 p1)
(nth 2 p2)
)
)
)
)
)
)
(foreach at data
(setq tag (nth 2 at)
at (last at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq ii (1+ ii)
val (strcat "A" (itoa ii))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

[jmcbride.161140]

Try the program

(Defun c:test (/ block-analysis ii ss sn dd data at p1 p2 val chk tag)
(Defun block-analysis (blk bname / att dat x v)
(if
(and (setq blk (vlax-ename->vla-object blk))
(= bname (vla-get-effectivename blk))
(equal (vlax-get-property blk "IsDynamicBlock") :vlax-true)
(setq att (car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
)
(setq dat (vl-remove-if
'null
(mapcar
'(lambda (x)
(if (setq v (vlax-variant-value (vla-get-value x)))
(cons (vla-get-propertyname x)
(if (= (type v) 'safearray)
(vlax-safearray->list v)
v
)
)
)
)
(vlax-safearray->list
(vlax-variant-value
(vla-getdynamicblockproperties blk)
)
)
)
)
x (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint blk))
)
dat (list (car x)
(cadr x)
(strcat (rtos (abs (cdr (assoc "Distance" dat))) 2 4)
"#"
(rtos (abs (cdr (assoc "Distance1" dat))) 2 4)
)
att
)
)
)
dat
)

(if (and (setq ii -1
ss (princ "\n Please select block(s) <Exit>:")
ss (ssget (list (cons 0 "insert")
(cons 66 1)
)
)
)
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "2400 ACM PANEL 1"))
(setq data (cons dd data))
)
)
(setq ii 99
data
(vl-sort
data
'(lambda (p1 p2)
(if (/= (car p1) (car p2))
(< (car p1) (car p2))
(if (/= (cadr p1) (cadr p2))
(< (cadr p1) (cadr p2))
(< (nth 2 p1)
(nth 2 p2)
)
)
)
)
)
)
(foreach at data
(setq tag (nth 2 at)
at (last at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq ii (1+ ii)
val (strcat "A" (itoa ii))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)



I get "error: no function definition: VLAX-ENAME->VLA-OBJECT" when I run the program.
Is there something in the code that I need to change to be specific to my blocks?

[kozmosovia]

I forget to add (vl-load-com) and have changed the code in the original post, please try it again.

[jmcbride.161140]

OK!

That worked awsome!

A couple thing I might need help with though. If I want to use it with multiple blocks, to I change this line

(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "2400 ACM PANEL 1"))
(setq data (cons dd data))

to look like this?

(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis sn "2400 ACM PANEL 1"))
(if (setq dd (block-analysis sn "whatever"))
(if (setq dd (block-analysis sn "whatever2"))
(setq data (cons dd data))

I have many different variations of the same block with different names.

Also, where could I (How could I) ad a pause for user input for the "A" in the attribute to be anything the user wants. We use "A-Z" for the first part of label.

I am really trying to learn as much as possible so as not to "glom" code off of everybody. Thank you for your valuable time!

Moderator Note:
Please use [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code)

[kozmosovia]

Try the modified code, please replace "New UPPER LETTER Blockname Here" with ur new block names.

(Defun c:test
(/ block-analysis ii ss sn dd data at p1 p2 val chk tag pfx)
(Defun block-analysis (blk bname / att dat x v)
(if
(and (setq blk (vlax-ename->vla-object blk))
(member (strcase (vla-get-effectivename blk)) bname)
(equal (vlax-get-property blk "IsDynamicBlock") :vlax-true)
(setq att (car (vlax-safearray->list
(vlax-variant-value (vla-getattributes blk))
)
)
)
(setq
dat (vl-remove-if
'null
(mapcar
'(lambda (x)
(if
(setq v (vlax-variant-value (vla-get-value x)))
(cons (vla-get-propertyname x)
(if (= (type v) 'safearray)
(vlax-safearray->list v)
v
)
)
)
)
(vlax-safearray->list
(vlax-variant-value
(vla-getdynamicblockproperties blk)
)
)
)
)
)
)
(setq x (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint blk))
)
dat (list (car x)
(cadr x)
(strcat (rtos (abs (cdr (assoc "Distance" dat))) 2 4)
"#"
(rtos (abs (cdr (assoc "Distance1" dat))) 2 4)
)
att
)
)
)
dat
)
(vl-load-com)
(if (and (setq ii -1
ss (princ "\n Please select block(s) <Exit>:")
ss (ssget (list (cons 0 "insert")
(cons 66 1)
)
)
)
)
(progn
(if
(= ""
(setq pfx (getstring "\n Enter the new Label prefix <A>:"))
)
(setq pfx "A")
(setq pfx (substr (strcase pfx) 1 1))
)
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(if (setq dd (block-analysis
sn
'("2400 ACM PANEL 1"
"New UPPER LETTER Blockname Here1"
"New UPPER LETTER Blockname Here2"
)
)
)
(setq data (cons dd data))
)
)
(setq ii 99
data
(vl-sort
data
'(lambda (p1 p2)
(if (/= (car p1) (car p2))
(< (car p1) (car p2))
(if (/= (cadr p1) (cadr p2))
(< (cadr p1) (cadr p2))
(< (nth 2 p1)
(nth 2 p2)
)
)
)
)
)
)
(foreach at data
(setq tag (nth 2 at)
at (last at)
)
(if (null (setq val (cdr (assoc tag chk))))
(setq ii (1+ ii)
val (strcat pfx (itoa ii))
chk (cons (cons tag val) chk)
)
)
(vla-put-textstring at val)
)
)
)
)

[jmcbride.161140]

Kosmo!

You are the best!

I am starting a new project today and will start testing and seeing if I find anything else that throws me for a loop!

This code will definetly save me some time!

[james.126519]

Kosmo,

I have another request for you, if you dont mind. I really dont like to bother people with this sort of stuff, but you are just too good at writing these codes! If I am bothering you, just let me know.

This Code below worked perfect. Then, you had modified the code for me to work by just reading the part length, rather than the width and length. Then, you modified that code to store the used part numbers as specific lengths and not redo all of the part marks if i re-ran the program. Can you modify this code below to do the same thing, remember the part numbers it assigns to specific sizes (width and height). This way, if i modify the size of one piece of glass and leave the other few hundred that I have already ordered alone, it will not assign new part numbers to the unchanged sizes. I hope that makes sense... I have re-attached the block I use for glass.

;;; Labeling Glasses
;;; All glass blocks should have two attribute tags: HEIGHT and WIDTH
(Defun C:LGlass (/ block-analysis BDAT BVAL DATA
GSIZ II NN NUM SN SS
TAG VBLK XX
)
(Defun block-analysis (blk tagx / at ll ur xx yy at att)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(cond ((= (vla-get-tagstring at) "WIDTH")
(setq xx (vla-get-textstring at))
)
((= (vla-get-tagstring at) "HEIGHT")
(setq yy (vla-get-textstring at))
)
((member (vla-get-tagstring at) tagx) (setq att at))
)
)
(if (and xx yy att)
(list (strcat xx yy) att)
nil
)
)

(setq BVal '(("GL-1" 100)
("GL-2" 200)
("NewBlockNameHere" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-analysis sn Tag))
(if (null (member (car xx) GSiz))
(setq GSiz (cons (car xx) GSiz))
)
(if (null (setq data (cdr (assoc nn BDat))))
(setq BDat (cons (list nn xx) BDat))
(setq BDat (subst (cons nn (cons xx data))
(assoc nn BDat)
BDat
)
)
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(foreach bn BVal
(setq num (cadr bn)
bn (car bn)
)
(foreach at (cdr (assoc bn BDat))
(vla-put-textstring
(cadr at)
(itoa (+ num (vl-position (car at) GSiz)))
)
)
)
(princ "done!")
)
)
(princ)
)

Moderator Note:
Please use [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code)

[kozmosovia]

That is possible but I m little busy these days, so please wait till I can find time to work on it.

[kozmosovia]

Just by quick sonsideration, will u change the labeled glass into a totally new size that new Label string is needed or u just change it to another existing size.
u know, the change of glasses may cause label lost, for example, if u have only 1 "A101" glass and u just change it into a new size, then what should the program to do:
1: Continue using "A101" and update the label system data
2: Delete "A101" from label system and create a new label ID
3: Using new label Id and still keep "A101" in the label system without any glass using it/

[james.126519]

Just by quick sonsideration, will u change the labeled glass into a totally new size that new Label string is needed or u just change it to another existing size.
u know, the change of glasses may cause label lost, for example, if u have only 1 "A101" glass and u just change it into a new size, then what should the program to do:
1: Continue using "A101" and update the label system data
2: Delete "A101" from label system and create a new label ID
3: Using new label Id and still keep "A101" in the label system without any glass using it/

Please have it so that it keeps A101 in the label system, unused, and assign a new label (or existing label if the size is already used somwhere) to the changed piece of glass.

[kozmosovia]

Just a rough and hurry code and I have not test it ehough, please try it.

Run a regen before calling this command after glasses were changed.

;;; Labeling Glasses
;;; All glass blocks should have two attribute tags: HEIGHT and WIDTH
(Defun C:LGL (/ proc-cdr-assoc proc-member
block-scan modi-att ALABEL ALABLE ASIZE
ATT BLOCKDATAX BNAME BNEXTLABEL BUSEDDATA
BVAL GSIZ II NN
SN SS TAG USEDDATA VBLK
XX
)
(Defun proc-cdr-assoc (lst tag id val / dat)
(if val
(if (null (setq dat (cdr (assoc tag lst))))
(setq lst (cons (list tag (cons id val)) lst))
(if (null (cdr (assoc id dat)))
(setq dat (append dat (list (cons id val)))
lst (subst (cons tag dat) (assoc tag lst) lst)
)
)
)
)
lst
)
(Defun proc-member (lst tag id / dat)
(if (null (setq dat (cdr (assoc tag lst))))
(setq lst (cons (list tag id) lst))
(if (null (member id dat))
(setq dat (append dat (list id))
lst (subst (cons tag dat) (assoc tag lst) lst)
)
)
)
lst
)
(Defun modi-att (att size val)
(vla-put-textstring att val)
(setq att (vlax-vla-object->ename att))
(vlax-ldata-put att "SaveSize" size)
(vlax-ldata-put att "SaveLabel" val)
)
(Defun block-scan (blk tagx / at att xx yy os ol str rtn)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(cond ((= (vla-get-tagstring at) "WIDTH")
(setq xx (vla-get-textstring at))
)
((= (vla-get-tagstring at) "HEIGHT")
(setq yy (vla-get-textstring at))
)
((member (vla-get-tagstring at) tagx)
(setq str (vla-get-textstring at)
att (vlax-vla-object->ename at)
os (vlax-ldata-get att "SaveSize")
ol (vlax-ldata-get att "SaveLabel")
att at
)
)
)
)
(if (and xx yy str)
(progn
(if (and ol (= str ol) os (= (strcat xx "#" yy) os))
(setq att nil)
)
(setq rtn (list (strcat xx "#" yy) att os ol))
)
)
rtn
)
(vl-load-com)
(setq BVal '(("GL1" 100)
("GL1T" 200)
("GL2" 300)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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
(command "_.Regen")
(princ (strcat "\n Scaning "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(repeat (sslength ss)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(progn
(setq xx (block-scan sn Tag)
BlockDataX (proc-member BlockDataX nn xx)
UsedData (proc-cdr-assoc
UsedData
nn
(nth 2 xx)
(nth 3 xx)
)
)
)
)
)
(princ "Done!")
(foreach blx BlockDataX
(foreach atx (cdr blx)
(setq atx (car atx)
GSiz (if (null (member atx GSiz))
(cons atx GSiz)
GSiz
)
)
)
)
(setq GSiz (vl-sort GSiz '<))
(princ (strcat "\n Processing "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(foreach blx BlockDataX
(setq BName (car blx)
BUsedData (cdr (assoc BName UsedData))
BNextLabel (mapcar 'cdr BUsedData)
)
(if (= (type (car BNextLabel)) 'str)
(setq BNextLabel (vl-sort BNextLabel '>)
BNextLabel (car BNextLabel)
BNextLabel (itoa (1+ (read BNextLabel)))
)
)
(foreach atx (cdr blx)
(if (setq att (cadr atx))
(progn
(setq ASize (car atx)
ALabel (cdr (assoc ASize BUsedData))
)
(if (null ALabel)
(if (nth 2 atx)
(setq ALabel BNextLabel
BNextLabel (itoa (1+ (read BNextLabel)))
)
(setq ALabel (itoa (+ (car (cdr (assoc BName BVal)))
(vl-position ASize GSiz)
)
)
)
)
)
(modi-att att ASize ALabel)
(setq BUsedData (cons (cons ASize ALabel) BUsedData))
)
)
)
)
)
)
(princ "done!")
(princ)
)

[james.126519]

Kozmo,

I ran the program and got the following:

Command: LGL

Valid blocks:GL1 GL1T GL2
Please select the Glass block(s) <Exit>:
Select objects: Specify opposite corner: 9 found

Select objects:

Scaning 9 pieces of glasses...; error: no function definition:
VLAX-ENAME->VLA-OBJECT

Command:

[kozmosovia]

I lost (vl-load-com) and have added it into last post, please try it again.
I also add a regen command before scanning glass blocks, if the drawing is big, such regen may cost some time, you can disable it by adding a ; before that line. But then u have to make sure to run regen manually, otherwise, the program may not run correctly becoz the field in glass not update.

[james.126519]

I lost (vl-load-com) and have added it into last post, please try it again.
I also add a regen command before scanning glass blocks, if the drawing is big, such regen may cost some time, you can disable it by adding a ; before that line. But then u have to make sure to run regen manually, otherwise, the program may not run correctly becoz the field in glass not update.

Kozmo,

How difficult would it be to add the ability to wipe the part mark memory away to start fresh if I need to? Also, I need the label numbers to be 1000 rather than 100, can I just change the number in the code and it should work properly?

[kozmosovia]

1: try this code, but i have not test.

(Defun C:ClearLGL (/ block-clear BVAL II NN SN SS TAG VBLK)
(Defun block-clear (blk tagx / at att)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(if (member (vla-get-tagstring at) tagx)
(progn
(setq att (vlax-vla-object->ename at))
(vlax-ldata-delete att "SaveSize")
(vlax-ldata-delete att "SaveLabel")
)
)
)
)
(vl-load-com)
(setq BVal '(("GL1" 100)
("GL1T" 200)
("GL2" 300)
("NewBlockNameHere" 400)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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
(command "_.Regen")
(princ (strcat "\n Clearing "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(repeat (sslength ss)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(block-clear sn Tag)
)
)
(princ "done!")
)
)
(princ)
)


2: you can directly change the number after the glass block name in
'(("GL1" 100) ("GL1T" 200) ("GL2" 300)) and it is only the start number of the sequence.

[james.126519]

You are awesome. Thank you so much!

One thing that has me baffled though, is it does not assign the part marks in any particular order. I have an example attached. it skips numbers for some reason? is this an easy fix?

1: try this code, but i have not test.

(Defun C:ClearLGL (/ block-clear BVAL II NN SN SS TAG VBLK)
(Defun block-clear (blk tagx / at att)
(foreach at (vlax-safearray->list
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
(if (member (vla-get-tagstring at) tagx)
(progn
(setq att (vlax-vla-object->ename at))
(vlax-ldata-delete att "SaveSize")
(vlax-ldata-delete att "SaveLabel")
)
)
)
)
(vl-load-com)
(setq BVal '(("GL1" 100)
("GL1T" 200)
("GL2" 300)
("NewBlockNameHere" 400)
)
VBlk (mapcar 'car BVal)
Tag '("GLASS-TAG" "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
(command "_.Regen")
(princ (strcat "\n Clearing "
(itoa (sslength ss))
" pieces of glasses..."
)
)
(repeat (sslength ss)
(setq nn (strcase (vla-get-effectivename
(vlax-ename->vla-object
(setq sn (ssname ss (setq ii (1+ ii))))
)
)
)
)
(if (member nn VBlk)
(block-clear sn Tag)
)
)
(princ "done!")
)
)
(princ)
)


2: you can directly change the number after the glass block name in
'(("GL1" 100) ("GL1T" 200) ("GL2" 300)) and it is only the start number of the sequence.

[kozmosovia]

Originally, the Glass was labeled by the glass size, becoz the program runs on multiple glass blocks, and the program sort all glass size from small to big. So the label string may not be continuous for one certain block. For example, if the used glass sizes for 2 glass blocks are 1x1 and 2x2 and 3x3. But glass block1 only has 1x1 and 3x3 and glass block2 has 2x2 and 3x3. While we set Glass block1 start from 100 and block2 from 1000, then 102 will be block1 with size of 2x2 which is NOT exist, so the program will just skip it. And 1001 the same situation becoz no glass size 1x1 for block2.

[peter]

Hi James,

I didn't read the entire thread but I wrote this solution and it works perfectly per your functional specification listed below.

Regards,

Peter

Please let me know if you encounter any bugs with it.

I work in the commercial glass industry, and I am looking for someone to help make my job a bit easier.

I have attached a file with an example of what I can do, and I will explain where I want to go from there.

In the drawing attached, I have four window elevations drawn. Each window elevation consists of four pieces of glass, which are represented as dynamic blocks. After I have my elevations drawn, I use EATTEXT to extract the glass sizes into a table format, which I use to order the glass.

I have to assign glass tag numbers to each piece of glass on each elevation for our field employees to use to locate where all of the glass goes when it comes bulk shipped to the jobsite in crates. So, after I create my table, I then have to start at the top of the "Glass-Tag" column and number each row 100, 101, 102, etc...

After I have the table filled in with the glass tags, I have to go to the elevations and mark the attributes to correspond with the marks I inserted in the table.

What I want to know is if there is a way a program can be written that after I fill out the tag numbers in the table, that I can have AutoCAD write those tags back to the corresponding attributes in the dynamic blocks.

I know this is possible, but I have no understanding of programming or any idea of how intense of a project that would be. I have seen this same scenario used by other companies (where they wrote their own LISP, but are not so willing to share!) :)

Is there anyone willing to help me out here?