TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: GDF on July 29, 2009, 02:59:48 PM
-
Does anyone have a routine for adding dtext in architectural units "feet" and "inches" to get a total?
The one below only does decimal without reading the inches.
14'-0" + 12'-4" = 26.00
(defun ADD-TXT (/ s1 lg index count c x a d totalarea atext apoint)
(setq S1 (ssget)
LG (sslength S1)
INDEX 0
COUNT 0
C 0)
(while (/= INDEX LG)
(setq X (ssname S1 INDEX)
A (entget X)
D (cdr (assoc 0 A)))
(if (= D "TEXT")
(progn (setq B (atof (cdr (assoc 1 A)))
C (+ C B)
COUNT (1+ COUNT))))
(setq INDEX (1+ INDEX)))
(setq TOTALAREA (rtos C 2 2))
(setq ATEXT (strcase (strcat "" TOTALAREA "")))
(while (not apoint)
(setq APOINT (getpoint "\n* Pick Location for Text in Drawing... *"))
(command "text" "j" "bl" APOINT 9 0 ATEXT))
(princ))
-
Hi Gary
Maybe if it is used something like:
(rtos (+ (distof "14'-0" 4)(distof "12'-4" 4)) 4 2) ;; having dimzin=3
"26'-4\""
-
Luis
I'm looking to pick the dtext objects in a drawing to get the total, then place that total as dtext in the drawing.
;;;this code will do it for dimensions
;;;Peter Jamtgaard
(defun ADIMIT (/ CNT ENAM EOBJ SSET)
(prompt "\n* Select All Dimensions to Total in Imperial Units *")
(setq CNT 0
SUM 0)
(if (setq SSET (ssget (list (cons 0 "DIMENSION"))))
(progn (command ".dim1" "update" SSET "")
;;added this line
(repeat (sslength SSET)
(setq ENAM (ssname SSET CNT)
CNT (1+ CNT)
EOBJ (vlax-ename->vla-object ENAM))
(vl-catch-all-apply
'(lambda (X) (setq SUM (+ SUM (vla-get-measurement X))))
(list EOBJ)))
;;(princ (strcat "\n" (rtos SUM 4 6)))
(princ (strcat "\n* Total Dimension = " (rtos SUM 4 6) " *"))))
(prin1))
-
need to practice.... there you go sir - super mickey mouse stuff - and assumes the strings are valid dimension data(s)
(defun C:ATXT ()
(setq total 0.0)
(while (setq ent (car (entsel "\nSelect text: ")))
(progn
(setq obj (vlax-ename->vla-object ent))
(setq str (vla-get-textstring obj))
(setq total (+ (distof str 4) total))
)
)
(princ "\nTotal=") (princ (rtos total 4 2)) (princ)
)
-
Just a quickie :lol:
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(vla-put-Alignment
(setq tObj (vla-addText spc tStr
(vla-getVariable doc "VIEWCTR")
(* (getvar "DIMSCALE") (getvar "DIMTXT"))))
acAlignmentMiddleCenter)
(while (eq 5 (car (setq gr (grread 't 5 0))))
(vla-move tObj
(vla-get-TextAlignmentPoint tObj) (vlax-3D-point (cadr gr))))
(vla-delete sel)))
(princ))
-
This would work fine if it read dtext objects in imperial units and got a total in imperial units.
;;;I am just wondering it it is possible to create a lisp routine that could be used to
;;;tabulate a total distance from text values. I would like to be able to click each piece
;;;of text and then have AutoCAD return the total
;;;by: Tim Willey
(defun TXCALCIT (/ app cal n l nu1 nu2 nu3 nu4 nu5 tx1 tx2 tx3 tx4)
(defun get_info ()
(setq nu1 (entget (ssname cal n)))
(setq nu2 (cdr (assoc 1 nu1)))
(setq nu3 (atof nu2))
)
(defun addc ()
(get_info)
(setq nu4 nu3)
(setq n (+ 1 n))
(while (/= l n)
(get_info)
(setq nu5 (+ nu4 nu3))
(setq nu4 nu5)
(setq n (+ 1 n))
)
)
(defun subc ()
(get_info)
(setq nu4 nu3)
(setq n (+ 1 n))
(while (/= l n)
(get_info)
(setq nu5 (- nu4 nu3))
(setq nu4 nu5)
(setq n (+ 1 n))
)
)
(defun multc ()
(get_info)
(setq nu4 nu3)
(setq n (+ 1 n))
(while (/= l n)
(get_info)
(setq nu5 (* nu4 nu3))
(setq nu4 nu5)
(setq n (+ 1 n))
)
)
(defun divdc ()
(get_info)
(setq nu4 nu3)
(setq n (+ 1 n))
(while (/= l n)
(get_info)
(setq nu5 (/ nu4 nu3))
(setq nu4 nu5)
(setq n (+ 1 n))
)
)
(initget "+ - * /")
(setq app (getkword
"\n* What application would you like to do:\(+,-,*,/)"
)
)
(if (or (= app "-") (= app "/"))
(princ "\n* Don't forget order counts. So pick carefully. *"
)
)
(princ "\nSelect numbers to calculate:")
(setq cal (ssget '((0 . "TEXT"))))
(setq n 0)
(setq l (sslength cal))
(while (/= l n)
(get_info)
(if (= nu3 0.0)
(progn
(ssdel (ssname cal n) cal)
(setq l (- l 1))
(setq n (- n 1))
)
)
(setq n (+ n 1))
)
(setq n 0)
(setq l (sslength cal))
(cond
((= app "+")
(addc)
)
((= app "-")
(subc)
)
((= app "*")
(multc)
)
((= app "/")
(divdc)
)
)
(initget "Replace Write")
(princ "\nAnswer= ")
(princ nu5)
(setq tx1
(getkword
"\n* What do you want do with the answer\(Replace, Write to screen):"
)
)
(cond
((= tx1 "Replace")
(setq tx2 (ssget '((0 . "TEXT"))))
(setq n 0)
(setq l (sslength tx2))
(while (/= n l)
(setq tx3 (entget (ssname tx2 n)))
(setq tx4 (subst (cons 1 (rtos nu5 2 1)) (assoc 1 tx3) tx3))
(entmod tx4)
(setq n (+ 1 n))
)
)
((= tx1 "Write")
(setq nu5 (rtos nu5 2 1))
(princ "\n* Pick point for text insertion")
(command "text" "j" "m" pause "" "" nu5)
)
)
(princ)
)
(princ)
-
Perfect
Thank you Luis
need to practice.... there you go sir - super mickey mouse stuff - and assumes the strings are valid dimension data(s)
(defun C:ATXT ()
(setq total 0.0)
(while (setq ent (car (entsel "\nSelect text: ")))
(progn
(setq obj (vlax-ename->vla-object ent))
(setq str (vla-get-textstring obj))
(setq total (+ (distof str 4) total))
)
)
(princ "\nTotal=") (princ (rtos total 4 2)) (princ)
)
-
Lee
I could not get yours to work in placing the new dtext total in the drawing.
-
Lee
I could not get yours to work in placing the new dtext total in the drawing.
Hmmm... Seems to work fine for me :?
-
This won't do it?
http://www.theswamp.org/index.php?topic=26556.0
-
Lee.
Nice routine! The text was too small in my environment.
FYI, Typically 5 units for text size here and DIMSCALE of 48 and DIMTXT of 0.125
Usually I use (* (getvar "DIMSCALE)(getvar "DIMTXT")) for text Size.
-
Lee.
Nice routine! The text was too small in my environment.
FYI, Typically 5 units for text size here and DIMSCALE of 48 and DIMTXT of 0.125
Usually I use (* (getvar "DIMSCALE)(getvar "DIMTXT")) for text Size.
Thanks Alan :-)
I normally use "TEXTSIZE", but I have seen "DIMTXT" used recently, but thanks for the heads-up, code updated.
Lee
-
As you know DIMTXT comes form the Current Dimension Style. The actual dim text size is derived
by (* DIMTXT DIMSCALE) and some use DIMSCALE of ONE but many do not use ONE.
DIMSIZE is the last used text size. Not sure which is more reliable for getting the most desired
text size. I suspect the dimension style may be somewhat constant. Hard to say.
-
True, I am always wondering which to use, and normally, whichever method I choose, people seem to always come back and say "The Text is to big/small...".
Thanks for the information about the sys vars, I suppose the choice is either TEXTSIZE or (* (getvar "DIMSCALE") (getvar "DIMTXT")), depending on the consistency of either Dimension Style or Text Style.
Lee
-
That's why I usually ask for a sample DWG. Seems I guess wrong too much of the time. 8-)
-
Lee
I could not get yours to work in placing the new dtext total in the drawing.
Hmmm... Seems to work fine for me :?
I'm using version 2008 and 2010
Command: dpick
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects:
Command:
The routine just stops without placing any text.
-
Lee
Never mind. It works but it placed the text way off or at the first text selected.
Thanks for sharing it.
Alan
I did a search first before I posted. I remember your routine now. I need to learn how to do a proper search.
Thanks for sharing your routine to.
-
Lee
Never mind. It works but it placed the text way off or at the first text selected.
Thanks for sharing it.
I'm not sure why that would be, but oh well. :-)
-
Maybe a trans would help? [Throwing Darts]
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(vla-put-Alignment
(setq tObj (vla-addText spc tStr
(vla-getVariable doc "VIEWCTR")
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
acAlignmentMiddleCenter)
(while (eq 5 (car (setq gr (grread 't 5 0))))
(vla-move tObj
(vla-get-TextAlignmentPoint tObj) (vlax-3D-point ([color=red]trans[/color] (cadr gr) 1 0))))
(vla-delete sel)))
(princ))
-
Yeah, nice idea Alan, could well be that :-)
-
Yeah, nice idea Alan, could well be that :-)
Alan
Lee's routine and your fix still will not let me pick the location for the new added text. The text jumps to 0,0.
-
I can't understand that.
My routine just adds the Text using at the point defined by the VIEWCTR sys var, then moves this text using mouse positions retrieved through the GrRead loop - I can't see where it is failing... :|
As an error catching exercise, what does your command line look like after running this?
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(princ "\nText About to be Placed.")
(vla-put-Alignment
(setq tObj (vla-addText spc tStr
(vla-getVariable doc "VIEWCTR")
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
acAlignmentMiddleCenter)
(princ "\nGrRead commences here. ")
(while (eq 5 (car (setq gr (grread 't 5 0))))
(vla-move tObj
(vla-get-TextAlignmentPoint tObj)
(vlax-3D-point (trans (cadr gr) 1 0))))
(princ "\nGrRead Complete.")
(vla-delete sel)))
(princ))
-
Command: (LOAD "E:/Arch_WorkOn/architettura/dpick2.lsp") C:DPICK
Command: dpick
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects:
Text About to be Placed.
GrRead commences here.
GrRead Complete.
Command:
The routine will still not let me place the dtext. THe routine places it at 0,0 still.
-
That is crazy... no errors whatsoever, and yet, I cannot get it to fail here :-(
-
Happens here the same as Gary pretty much. Once you select the text, the code ends, and the new text is placed at 0,0
DPICK
Select objects: Specify opposite corner: 4 found
Select objects:
Text About to be Placed.
GrRead commences here.
GrRead Complete.
-
Another version to test:
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(while (eq 5 (car (setq gr (grread 't 5 0))))
(vla-put-TextAlignmentPoint tObj (vlax-3D-point (trans (cadr gr) 1 0)))
)
))
(princ))
-
The problem seems to be with the grread loop. Exit the selection with hitting the right click, and then exit hitting enter. If I hit enter I can see the text, and place it, but if I hit the right click, then it just places.
edit: Added code to show what works here
(while (not (eq 3 (car (setq gr (grread 't 5 0)))))
-
Lee, no need to position the new text other than '(0 0) as it will only remain there a nano second. :)
No need for the MOVE, just update the text object position.
-
I think my version solved that problem. No?
-
I think my version solved that problem. No?
Nope.
Only mine.... I win.... :-)
-
I think my version solved that problem. No?
Nope.
Only mine.... I win.... :-)
Nope, still same problem...
-
Thanks for the pointers Alan :-)
How 'bout this approach:
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(while
(progn
(setq gr (grread 't 5 0))
(cond ((eq 5 (car gr))
(vla-put-TextAlignmentPoint tObj
(vlax-3D-point (trans (cadr gr) 1 0))) t)
(t nil))))))
(princ))
-
I think my version solved that problem. No?
Nope.
Only mine.... I win.... :-)
Nope, still same problem...
Did you change the ' while ' line in Lee's code to mine? It worked here once I did that.
-
Try this.
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(princ "\nText About to be Placed.")
(vla-put-Alignment
(setq tObj (vla-addText spc tStr
(vla-getVariable doc "VIEWCTR")
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
acAlignmentMiddleCenter)
(princ "\nGrRead commences here. ")
[color=red] (while (not (eq 3 (car (setq gr (grread 't 5 0)))))[/color]
(vla-move tObj
(vla-get-TextAlignmentPoint tObj)
(vlax-3D-point (trans (cadr gr) 1 0))))
(princ "\nGrRead Complete.")
(vla-delete sel)))
(princ))
-
Tim, did you try my version?
It will exit with left or right click or Enter. The text is updated to the last known cursor position.
Mine doesn't work for you?
-
Could it be the varying speeds of our PC's that are affecting this? If the grread is being evaluated too quickly after the ssget input is completed, meaning that the right-click or enter is being swept into the grread loop?
Just a theory :P
-
Tim,
just tried the routine and returns this:
DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13
if I hit enter
(so please return the prize that was given away of $100,000,000 swamp dollars :-P)
-
Tim, did you try my version?
It will exit with left or right click or Enter. The text is updated to the last known cursor position.
Mine doesn't work for you?
The latest one didn't work unless I hit enter or the space bar. If I use the right click to end the ssget call, then it would just place it at 0,0.
Could it be the varying speeds of our PC's that are affecting this? If the grread is being evaluated too quickly after the ssget input is completed, meaning that the right-click or enter is being swept into the grread loop?
Just a theory :P
That is what I was thinking. That is why I changed it the way I did, so it will only exit once you pick a point, instead of stop moving the mouse. Yours would stop if you hit any button while moving the text.
-
Tim,
just tried the routine and returns this:
DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13
if I hit enter
(so please return the prize that was given away of $100,000,000 swamp dollars :-P)
Hey!! That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:
-
Tim,
just tried the routine and returns this:
DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13
if I hit enter
(so please return the prize that was given away of $100,000,000 swamp dollars :-P)
Hey!! That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:
:)
if i run the first one posted by Lee... it works here using A2009
-
Tim,
just tried the routine and returns this:
DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13
if I hit enter
(so please return the prize that was given away of $100,000,000 swamp dollars :-P)
Hey!! That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:
:)
if i run the first one posted by Lee... it works here using A2009
Even if you right click to end the text selection? I didn't test it in my '09, only '06.
-
One more 8-)
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(while (and(/= 3 (car (setq gr (grread 't 5 0)))) (listp (cadr gr)))
(vla-put-TextAlignmentPoint tObj (vlax-3D-point (trans (cadr gr) 1 0)))
)
))
(princ))
-
Thanks a winner Alan!!!! You can have my prize... :oops:
-
Even if you right click to end the text selection? I didn't test it in my '09, only '06.
yep... right,left or enter works
-
Too much virtual beer I think. 8-)
Off to play some tennis if this rain will hold off.
-
Even if you right click to end the text selection? I didn't test it in my '09, only '06.
yep... right,left or enter works
It is because you have it setup to have the shortcut menu with the right click, and I do not. I just turned it on, and right click worked, but turning it off again, and it won't work. Alan brought to my attention on one of my polyline routines that uses grread. At least we know why now.
-
Just curious, did my approach in reply #31 work for any of you guys? :-)
-
Worked in my test.
-
Thanks for testing it Alan, hopefully Tim and Gary will get good results also. :wink:
-
Thanks a winner Alan!!!! You can have my prize... :oops:
Works here to. I would suggest that the new text match the selected in layer and size.
Lee, you have a winner. I will have to study how Alan fixed it....even though it's over my head.
Lee thanks for sharing your routine.
-
No problem. :-)
To match layer, color, height:
;; By Lee
;; Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0)) 1.))
(vla-put-Alignment tObj acAlignmentMiddleCenter)
[color=red] (foreach prop '(Layer Height Color)
(vlax-put-property tObj prop
(vlax-get-property
(vlax-ename->vla-object (ssname ss 0)) prop)))[/color]
(while
(progn
(setq gr (grread 't 5 0))
(cond ((eq 5 (car gr))
(vla-put-TextAlignmentPoint tObj
(vlax-3D-point (trans (cadr gr) 1 0))) t)
(t nil))))))
(princ))
-
Lee
I used Alan"s version to get it to work:
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
(vl-load-com)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
(setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
(setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
(setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
(*(getvar "DIMSCALE")(getvar "DIMTXT"))))
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(foreach prop '(Layer Height Color)
(vlax-put-property tObj prop
(vlax-get-property
(vlax-ename->vla-object (ssname ss 0)) prop)))
(while (and(/= 3 (car (setq gr (grread 't 5 0)))) (listp (cadr gr)))
(vla-put-TextAlignmentPoint tObj (vlax-3D-point (trans (cadr gr) 1 0)))
)
))
(princ))
Thanks again my friend.
-
Not a problem, I wasn't sure which version worked for who (they all seem to work for me :-) )
Glad you got what you wanted 8-)
Lee