Adding Attributes

[michael.viscetto65572]

We are using ADT 2004.
We do mostly residential projects and our titleblock is one large attributed block. The titleblock has two areas where we break down the square footage of the building.
The first part is for the building sq. ft.

main level =
upper level =
bonus room =
basement =

TOTAL = _____________

The second part is for concrete sq. ft.

garage =
back patio =
front patio =
sidewalk =
driveway =
a/c pad =
misc =

TOTAL = ___________

My question is this,
Is it possible to get the attributes to add themselves together like I would
do in a spread sheet?

Thanks
Michael

[jim.vipond]

Yes.

You would need to get the value of each attribute and convert to a real or integer before adding together (see atof or atoi functions).

Good luck

[peter]

Try this and modify the path to your excel object if necessary.

Peter Jamtgaard



(defun C:ExportAttributes (/ lstSelection)
(while (not (setq lstSelection (entsel "\nSelect titleblock: ")))
(princ "\nNull selection please select again: ")
)
(if (setq lstAttributeTextPairs (getAttributeTextPairs (car lstSelection)))
(PROGN
(foreach n lstattributeTextPairs (print n))
(listTOCSVFile (strcat
(getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
"-TitleAttributes.csv"
)
lstAttributeTextPairs
","
)
)
)
)
(defun GetAllAttributes (objSelection /)
(print "\nGetallAttributes: ")
(if (= (type objSelection) 'ENAME)
(setq objSelection (vlax-ename->vla-object objSelection))
)
(if (vlax-property-available-p objSelection "hasattributes")
(if (= (vla-get-hasattributes objSelection) :vlax-true)
(vlax-safearray->list
(variant-value
(vla-getattributes objSelection)
)
)
)
)
)
(defun GetAttributeTextPairs (objSelection / lstAttributes)
(print "\nGetAttributeTextPairs: ")
(if (setq lstAttributes (getAllAttributes objSelection))
(progn
(mapcar '(lambda (objAttribute) (cons (strcase (vla-get-tagstring objAttribute))
(strcase (vla-get-textstring objAttribute))
)
)
lstAttributes
)
)
)
)
;Export a list of sublists of strings to a text file
(defun ListTOCSVFile (strFilename lstOfSublists strChar / strText strText2)
(print strFileName)
(setq z (open strFileName "w"))
(foreach lstSubList lstOfSublists
(setq strText (nth 0 lstSubList))
(print strText)
(if (= (type strText) 'INT) (setq strText (itoa strText)))
(if (= (type strText) 'REAL)(setq strText (rtos strText 2)))
(if (= (type (cdr lstSublist)) 'LIST)
(foreach strText2 (nth 1 lstSubList)
(if (= (type strText2) 'INT) (setq strText2 (itoa strText2)))
(if (= (type strText2) 'REAL)(setq strText2 (rtos strText2 2)))
(setq strText (strcat strText strChar strText2))
)
(progn
(setq strText2 (cdr lstSubList))
(if (= (type strText2) 'INT) (setq strText2 (itoa strText2)))
(if (= (type strText2) 'REAL)(setq strText2 (rtos strText2 2)))
(setq strText (strcat strText strChar strText2))
)
)
(write-line strText z)
)
(startapp "C:\\Program Files\\Microsoft Office\\Office10\\EXCEL.EXE" strFilename)
(prin1)
)

[kennet.sjoberg]

Helper need help !

I am trying to help Michael with the code he wants, but now I do need help myself.
The program find all blocks named "Myblock" and calculate and update the attributes Total1 and Total2 with the sum of corresponding attributes.
Everything looks good until I do the Command : regen, then all block will have the same result.
What am I doing wrong when all Total1 and Total2 turns out equal when doing regen ?



(defun c:sat ( / SelSet Items Counter Total1 Total2 EntName AttName EntDxf )
(setq SelSet (ssget "x" '((-4 . "<and" )(0 . "INSERT" )(2 . "MYBLOCK" )(-4 . "and>" ))) )
(if SelSet
(progn
(setq Items (sslength SelSet ) )
(setq Counter -1 )
(repeat Items
(setq Total1 0 Total2 0 )
(setq Counter (1+ Counter ) )
(setq EntName (ssname SelSet Counter ) )
(setq AttName (entnext EntName ) )
(while AttName
(setq EntDxf (entget AttName ) )
(cond
((= (cdr (assoc 2 EntDxf )) "MAIN_LEVEL" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "UPPER_LEVEL" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "BONUS_ROOM" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "BASEMENT" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 EntDxf ))))) )
(t nil)
)
(cond
((= (cdr (assoc 2 EntDxf )) "GARAGE" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "BACK_PATIO" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "FRONT_PATIO" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "SIDEWALK" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "DRIVEWAY" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "MISC" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
((= (cdr (assoc 2 EntDxf )) "A/C_PAD" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 EntDxf ))))) )
(t nil)
)
(if (= (cdr (assoc 0 (entget AttName ))) "SEQEND" ) (setq AttName nil ) (setq AttName (entnext AttName )) )
)
(setq AttName EntName )
(while (setq AttName (entnext AttName ) )
(setq EntDxf (entget AttName ) )
(cond
((= (cdr (assoc 2 EntDxf )) "TOTAL1" )
(progn
(setq EntDxf (subst (cons '1 (itoa Total1 )) (assoc 1 EntDxf ) EntDxf ) )
(entmod EntDxf )
)
)
((= (cdr (assoc 2 EntDxf )) "TOTAL2" )
(progn
(setq EntDxf (subst (cons '1 (itoa Total2 ) ) (assoc 1 EntDxf ) EntDxf ) )
(entmod EntDxf )
)
)
(t nil)
)
)
(entupd EntName )
)
)
(princ "MyBlock not found ! " )
)
(princ)
)

: ) Happy Computing !

kennet

[kennet.sjoberg]

attribs.dwg as complement

open attrib.dwg
load and run sat, and the attributes will have correct values
regen the drawing and all attributes Total1/Total2 are equal.

Why ?

: ) Happy Computing !

kennet

[jim.vipond]

Without looking at your code & drawing.

Is it that all blocks of the same name are having their attributes set to the same value. If so you will have to make sure that you are changing the attributes on each via their handles or other features in the selection set.

Jim.

[kennet.sjoberg]

Thanks for trying Jim

All blocks ( have the same name "myblock" ) and have different values in their attributes
I am stepping through each block and do the calculation and update the attribute Total1 and Total2 in that particular block.
Everything looks great, and all blocks have the correct sum in Total1 and Total2, until I do the command regen.

Please for understanding, open the dwg and run the code, it will not do any harm.

: ) Happy Computing !

kennet

[kennet.sjoberg]

OK Michael, here is the working code.
Hope You learn lisp reading the code, I have learn when writing it ; )


(defun c:sat ( / SelSet Items Counter Total1 Total2 BlkName AttName AttDxf )
(setq SelSet (ssget "x" '((-4 . "<and" )(0 . "INSERT" )(2 . "MYBLOCK" )(-4 . "and>" ))) )
(if SelSet
(progn
(setq Items (sslength SelSet ) )
(setq Counter -1 )
(repeat Items
(setq Total1 0 Total2 0 )
(setq Counter (1+ Counter ) )
(setq BlkName (ssname SelSet Counter ) )
(setq AttName (entnext BlkName ) )
(while AttName
(setq AttDxf (entget AttName ) )
(cond
((= (cdr (assoc 2 AttDxf )) "MAIN_LEVEL" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "UPPER_LEVEL" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "BONUS_ROOM" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "BASEMENT" ) (setq Total1 (+ Total1 (atoi (cdr (assoc 1 AttDxf ))))) )
(t nil)
)
(cond
((= (cdr (assoc 2 AttDxf )) "GARAGE" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "BACK_PATIO" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "FRONT_PATIO" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "SIDEWALK" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "DRIVEWAY" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "MISC" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
((= (cdr (assoc 2 AttDxf )) "A/C_PAD" ) (setq Total2 (+ Total2 (atoi (cdr (assoc 1 AttDxf ))))) )
(t nil)
)
(if (= (cdr (assoc 0 (entget AttName ))) "SEQEND" ) (setq AttName nil ) (setq AttName (entnext AttName )) )
)
(setq AttName BlkName )
(while AttName
(setq AttDxf (entget AttName ) )
(cond
((= (cdr (assoc 2 AttDxf )) "TOTAL1" )
(progn
(setq AttDxf (subst (cons '1 (itoa Total1 )) (assoc 1 AttDxf ) AttDxf ) )
(entmod AttDxf )
)
)
((= (cdr (assoc 2 AttDxf )) "TOTAL2" )
(progn
(setq AttDxf (subst (cons '1 (itoa Total2 ) ) (assoc 1 AttDxf ) AttDxf ) )
(entmod AttDxf )
)
)
(t nil)
)
(if (= (cdr (assoc 0 (entget AttName ))) "SEQEND" ) (setq AttName nil ) (setq AttName (entnext AttName )) )
)
(entupd BlkName )
)
)
(princ "MyBlock not found ! " )
)
(princ)
)

: ) Happy Computing !

kennet

ps. Of course You have to change "MyBlock" to Your block name in the code.

[stephen.coff]

Kennet,
Could you assist me here, please.
I was looking at your code and it looks similar to what I require.
I want to be able to select "X" amount of blocks all of the same type.
The blocks name is "Grille Air Qty" and I want to add all of the attributes labelled
"AIR_QTY" from all of the selected blocks together and then then print a total.

I have attached the block for refference, any assistance would be grately appreciated.

Stephen

[stephen.coff]

Kennet,
Whilst no really understand lisp very well I am stuck.
I have looked at the code above and tried to alter it to suit. I don't know how to add all the values together from the "AIR_QTY" attributes. Also, is possible to get the routine to tell me if one of the tags values couldn't be read, which one it was. Like "Block .. Selected Could Not Be Read" ?

Below is the routine as it stands:


(defun c:SysTotal (/ SelSet Items Counter BlkName BlOrg AttName AirQty Totalair AttDxf)
(setq SelSet (ssget '((-4 . "<and")
(0 . "INSERT")
(2 . "Grille Air Qty")
(-4 . "and>")
)
)
)
(if SelSet
(progn
(setq Items (sslength SelSet))
(setq Counter -1)
(repeat Items
(setq Totalair 0)
(setq Counter (1+ Counter))
(setq BlkName (ssname SelSet Counter))
(setq BlOrg (assoc 10 (entget BlkName)))
(setq AttName (entnext BlkName))
(while AttName
(setq AttDxf (entget AttName))
(if (= (cdr (assoc 2 AttDxf)) "AIR_QTY")
(setq Airqty ( (atoi (cdr (assoc 1 AttDxf))))
) ;_end if
(if (= (cdr (assoc 0 (entget AttName))) "SEQEND")
(setq AttName nil)
(setq AttName (entnext AttName))
) ;_end if
) ;_end while
(setq AttName BlkName)
) ;_end repeat
) ;_end progn
(princ "\n...WARNING...Tag(s) Could Not Be Read ! ")
) ;_end if
(princ
(strcat "Total Air Of " (itoa Items) " Grilles Selected Is: "
(itoa totalair)
)
)
(princ)
) ;_end defun


Your help would be grately appreciated.

Stephen

[fixo]

Hi Stephen

Here is quick code snip how to
calculate summ of attribute values

Change to your suit:



(if
(setq ss (ssget "_X" ;<-- X means entire database
(list
(cons 0 "INSERT")
(cons 2 "Grille & Air Qty");<-- correct block name
(cons 66 1);<-- with attributes
(cons 410 "Model"); <--just in model
)
)
)
(progn
(setq tot 0 i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
an (entnext en))
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
)
(setq an (entnext an))
)
)
)
)
(alert (strcat "Total Air Of " (itoa Items) " Grilles Selected Is: "
(vl-princ-to-string (fix tot))))

[stephen.coff]

Thank you Fixo for your reply.
I have looked at what you said and changed it minimally. I removed the "_x" from the ssget as I want to select the items individually rather all of them and adjusted the grile name. I have checked all the brackets are right though it still errors and i have no idea whats wrong. See below:


(defun c:SysTotal (/ sstot en ad an tot)
(if
(setq sstot (ssget '(list (cons 0 "INSERT")
(cons 2 "Grille Air Qty")
(cons 66 1)
(cons 410 "Model")
)
)
) ;_end setq
(progn
(setq tot 0
i -1
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
an (entnext en)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
) ;_end and
(setq an (entnext an))
) ;_end while
) ;_end repeat
) ;_end progn
) ;_end if
(alert (strcat "Total Air Of "
(itoa Items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
) ;_end defun


Command line is saaying: ; error: bad argument type: lselsetp nil

[stephen.coff]

Can anyone help me please, I have an error though not sure where or what ?


Stephen

[David.Hoole]

Stephen

Your code is finding a null value where it expects to find a selection set.

Try removing the apostrophe from your SSGET argument. It's not required if you use the LIST function:

(setq sstot (ssget (list (cons 0 "INSERT")

[stephen.coff]

David,
Thank you, will try.

Stephen

[stephen.coff]

David,
This is the current routine though still the same responce, any further suggestions ?



(defun c:SysTotal (/ sstot en1 ad tot)
(if
(setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille Air Qty")
(cons 66 1)
(cons 410 "Model")
)
)
) ;_end setq
(progn
(setq tot 0
i -1
)
(repeat (sslength ss)
(setq en1 (ssname ss (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
) ;_end and
(setq an (entnext an))
) ;_end while
) ;_end repeat
) ;_end progn
) ;_end if
(alert (strcat "Total Air Of "
(itoa Items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
) ;_end defun

Could you try it and see if you have the same problem ?
Attached is the same block I am trying to read.

Stephen

[fixo]

Hi Stephen
Sorry for the late

Here is working version I hope
I tested it on your last attached drawing,
seems to be working for me
Tested in A2007eng only



(defun c:SysTotal (/ ad an en1 i items sstot tot)
(if
(setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille_Air_Qty")
(cons 66 1)
(cons 410 "Model")
)
)
) ;_end setq
(progn
(setq tot 0
i -1
items 0
)
(repeat (sslength sstot)
(setq en1 (ssname sstot (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
(setq items (1+ items))
) ;_end and
(setq an (entnext an))
) ;_end while
) ;_end repeat
) ;_end progn
) ;_end if
(alert (strcat "Total Air Of "
(itoa items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
) ;_end defun

[stephen.coff]

Thank you Fixo,
I am sure that will work. Thanks yet once again.

Stephen

[stephen.coff]

Thank you fixo,
Works perfect.

Stephen

[fixo]

You are quite welcome,
Glad if that helps
Cheers :)

~'J'~

[stephen.coff]

Fixo,
Funny you just replied. I was just playing with the routine and guess what, I stuffed things up again.
I tried to get the routine to make a textstyle "AIRQTY" and create "DEFPOINTS" layer.
I thought it might be better to writie the answer on the drawing rather alert. Not sure what is wrong though I won't aknowledge the blocks as Iselect them. Could you please have a look for me and see if you notice anything obvious.



;;; original code by fixo, augi

(defun c:SysTotal (/ ad an en1 i items sstot pkpt tot oldclayer)
(if
(setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille Air Qty")
(cons 66 1)
(cons 410 "Model")
)
)
)
(progn
(setq tot 0
i -1
items 0
)
(repeat (sslength sstot)
(setq en1 (ssname sstot (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
(setq items (1+ items))
)
(setq an (entnext an))
)
)
)
)
(setq oldclayer (getvar "clayer"))
(command "-layer" "m" "DEFPOINTS" "C"
"8" "DEFPOINTS" "Lt" "CONTINUOUS"
"DEFPOINTS" ""
)
(command "_style" "AIRQTY" "arial" "125" "1" "0" "n" "n")
(setq pkpt (getpoint "\PICK LOCATION FOR AIR QTY TO BE PLACED"))
(alert (strcat "Total Air Of "
(itoa items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
(command "_text" "style" "AIRQTY" "justify" "mc" pt1 "0" tot)
(setvar "clayer" oldclayer)
)


Stephen

[fixo]

Hi Stephen
You missed double quotes at the end of TEXT command
and also you used 'pt1' variable name for text insertion point
instead of 'pkpt'
watch on correct names please

Hope this will works, I can't test this though, my
main machine is still in the repair, too hot weather here...



(defun c:SysTotal (/ ad an en1 i items sstot pkpt tot oldclayer)
(if
(setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille_Air_Qty")
(cons 66 1)
(cons 410 "Model")
)
)
)
(progn
(setq tot 0
i -1
items 0
)
(repeat (sslength sstot)
(setq en1 (ssname sstot (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
(setq items (1+ items))
)
(setq an (entnext an))
)
)
)
)
(setq oldclayer (getvar "clayer"))
(command "_.-layer" "m" "DEFPOINTS" "C"
"8" "DEFPOINTS" "Lt" "CONTINUOUS"
"DEFPOINTS" ""
)
(command "_.style" "AIRQTY" "arial" "125" "1" "0" "n" "n")
(setq pkpt (getpoint "\PICK LOCATION FOR AIR QTY TO BE PLACED"))
(alert (strcat "Total Air Of "
(itoa items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
(command "_.text" "_St" "AIRQTY" "_J" "_MC" pkpt 0.0 (vl-princ-to-string (fix tot)) "")
(setvar "clayer" oldclayer)
)

[stephen.coff]

Thank you fixo.
Sorry I should look more closely, those were silly errors I should have picked up on.

Stephen

[fixo]

Do not angry, we all are still learning here
:)

[stephen.coff]

fixo,
not angry. They were just silly mistakes that I should have noticed.

I have been playing with this further and added a another attribute to a block which I wanted this routine to also update with the air quantity. I have had a go though not doing something correct. The block name is "VAV" and the tag is "VAVAIRQTY".
The command line is showning this:
Command: SYSTOTAL2 Unknown command "SYSTOTAL2". Press F1 for help.
Command: Total Air Of 2 Grilles Selected Is: 1000Regenerating model.



(defun c:SysTotal2 (/ ad an en1 i items sstot pkpt tot oldclayer)
(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille Air Qty")
(cons 66 1)
(cons 410 "Model")
)
)
)
(progn
(setq tot 0
i -1
items 0
)
(repeat (sslength sstot)
(setq en1 (ssname sstot (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
(setq items (1+ items))
)
(setq an (entnext an))
)
)
)
)
(setq oldclayer (getvar "clayer"))
(command "_.-layer" "m" "DEFPOINTS" "C"
"8" "DEFPOINTS" "Lt" "CONTINUOUS"
"DEFPOINTS" ""
)
(command "_.style" "AIRQTY" "arial" "125" "1" "0" "n" "n")
(princ "\nPICK VAV TAG TO UPDATE WITH AIR QTY")
(setq ss
(ssget (list (cons 0 "INSERT") (cons 410 "Model") (cons 2 "VAV"))
)
)
(setq blk (vlax-ename->vla-object (ssname ssblk 0)))
(setq atts (vlax-invoke blk "Getattributes"))
(foreach at atts
(cond
((eq "VAVAIRQTY" (vlax-get at 'TagString))
(vlax-put at
'TextString
(strcat (vl-princ-to-string (fix tot)) "l/s")
)
)
)
)
(vla-update blk)
(setq pkpt (getpoint "\PICK LOCATION FOR AIR QTY TO BE PLACED"))
(command "_.text"
"_St"
"AIRQTY"
"_J"
"_MC"
pkpt
0.0
(vl-princ-to-string (fix tot))
""
)
(princ (strcat "Total Air Of "
(itoa items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
(setvar "clayer" oldclayer)
(vla-regen adoc acactiveviewport)
(vla-endundomark
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(princ)
)

If you could check this for me I would be most grateful.


Stephen

[fixo]

Sorry Stephen, I'd just come back right now,
I'll testing this routine extensively tomorrow

(02:00 local here)

[stephen.coff]

fixo,
That would be great, thank you.

Stephen

[stephen.coff]

Fixo,
Were you able to have a look the routine yet ?

Stephen

[fixo]

Sorry for the late
Please, attach your new block drawing here

[stephen.coff]

Fixo,
Thank you for assisting me. See attached blocks as requested.

Stephen

[fixo]

Ok, I have started to work with them

[fixo]

Try this instead, there is just 1 mistake was found
Also, I changed text command on ActiveX method,
remove them if no needed and command name on "SYT"
(I like a short names)



(defun c:Syt (/ ad adoc an apt atts blk en1 i items
oldclayer pkpt ss ssblk sstot tot txtobj)

(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (setq sstot (ssget (list (cons 0 "INSERT")
(cons 2 "Grille Air Qty")
(cons 66 1)
(cons 410 "Model")
)
)
)
(progn
(setq tot 0
i -1
items 0
)
(repeat (sslength sstot)
(setq en1 (ssname sstot (setq i (1+ i)))
an (entnext en1)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget an))))
(and (setq ad (entget an))
(eq "AIR_QTY" (cdr (assoc 2 ad)))
(setq tot (+ tot (distof (cdr (assoc 1 ad)))))
(setq items (1+ items))
)
(setq an (entnext an))
)
)
)
)
(setq oldclayer (getvar "clayer"))
(command "_.-layer" "m" "DEFPOINTS" "C"
"8" "DEFPOINTS" "Lt" "CONTINUOUS"
"DEFPOINTS" ""
)
(command "_.style" "AIRQTY" "arial" "125" "1" "0" "n" "n")
(princ "\nPICK VAV TAG TO UPDATE WITH AIR QTY")
(setq ssblk ;<-- the mistake was found here (I changed 'ss' on 'ssblk', watch for var names, please)
(ssget "_X" (list (cons 0 "INSERT") (cons 410 "Model") (cons 2 "VAV"))
)
)
(if (> (sslength ssblk) 1)
(alert "Note. More than 1 blocks \"VAV\" selected")
)
(setq blk (vlax-ename->vla-object (ssname ssblk 0)))
(setq atts (vlax-invoke blk "Getattributes"))
(foreach at atts
(cond
((eq "VAVAIRQTY" (vlax-get at 'TagString))
(vlax-put at
'TextString
(strcat (vl-princ-to-string (fix tot)) "l/s")
)
)
)
)
(vla-update blk)
(setq pkpt (getpoint "\PICK LOCATION FOR AIR QTY TO BE PLACED"))
;;;(command "_.text"
;;;"_St"
;;;"AIRQTY"
;;;"_J"
;;;"_MC"
;;;pkpt
;;;0.0
;;;(vl-princ-to-string (fix tot))
;;;""
;;;)

; add text object to model space
(setq txtobj (vlax-invoke
(vla-get-modelspace adoc) 'AddText
(vl-princ-to-string (fix tot)) ;string
pkpt ;insertion point
(getvar "TEXTSIZE");text height
))
; convert insertion point to variant of doubles
(setq apt (vlax-3d-point pkpt))
; set alignment property to middle center
(vla-put-alignment txtobj acAlignmentMiddleCenter)
; set text alignment property to insertion point
(vla-put-textalignmentpoint txtobj apt)
(princ (strcat "Total Air Of "
(itoa items)
" Grilles Selected Is: "
(vl-princ-to-string (fix tot))
)
)
(setvar "clayer" oldclayer)
(vla-regen adoc acactiveviewport)
(vla-endundomark
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(princ)
)
(princ "\n Type SYT to execute...")
(princ)
; TesT : (c:Syt)

[stephen.coff]

fixo,
Thank you for reviewing my attempt. I quickly ran the routine though it errored, i have pasted the command line below. I am pretty tired and just about to leave, I will have a further look at it tomorrow. It might be something simple I can work out. Thank you once again.


command line:
Command: SYT
Select objects: 0 found
Select objects: 0 found, 0 total
Select objects: 0 found, 0 total
Select objects: 0 found, 0 total
Select objects: 0 found, 0 total
Select objects: 0 found, 0 total
Select objects: 0 found, 0 total
Select objects:
_.-layer
Current layer: "Defpoints"
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: m
Enter name for new layer (becomes the current layer) <Defpoints>: DEFPOINTS
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: C
New color [Truecolor/COlorbook] : 8
Enter name list of layer(s) for color 8 <Defpoints>: DEFPOINTS Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: Lt
Enter loaded linetype name or [?] <Continuous>: CONTINUOUS
Enter name list of layer(s) for linetype "CONTINUOUS" <Defpoints>: DEFPOINTS
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]:
Command: _.style Enter name of text style or [?] <AIRQTY>: AIRQTY
Existing style. Full font name = Arial
Specify full font name or font filename (TTF or SHX) <ARIAL.TTF>: arial Specify
height of text or [Annotative] <125.00000000>: 125 Specify width factor
<1.00000000>: 1
Specify obliquing angle <0.00000000>: 0 Display text backwards? [Yes/No] <No>:
n Display text upside-down? [Yes/No] <No>: n
"AIRQTY" is now the current text style.
Command:
PICK VAV TAG TO UPDATE WITH AIR QTY; error: bad argument type: lselsetp nil


Stephen

[fixo]

I tested this routine on attached drawing
Maybe something wrong with block names?
Let me know if I am wrong or attach complete
drawing for the test
(tested on A2007 only)