Community
12601 Views, 38 Replies
This is probably a really easy thing for lsp, but I don't know it! 
I have many floorplans and each room has a polyline around it.
What I'd like to do, is be able to select multiple (or single) polylines and have a dynamic field with the area attached to each polyline placed in the middle (or on a consistent edge, say top left). Preferably with custom units as we use mm for the drawings, but would want the area in m2. Also custom text heights.
Any ideas? I can find a lot of 'put the area in the middle' scripts, but they're either not dynamic or they require a click to place each one - and with over 700 floorplans and over a hundred or more rooms on some, it's not really possible to do each one individually!
Thanks for any help!
Would this help you with it .... ? 
(defun c:Test (/ *error* pl x y i sn)
(vl-load-com)
;;; Tharwat 17. May. 2012 ;;;
(defun *error* (msg)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(if (not acdoc)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\n select a Polyline :")
(if (setq pl (ssget '((0 . "*POLYLINE") (-4 . "&") (70 . 1))))
(progn
(vla-StartUndoMark acdoc)
(repeat (setq i (sslength pl))
(setq sn (ssname pl (setq i (1- i))))
(WriteArea sn)
)
(vla-EndUndoMark acdoc)
)
(princ)
)
(princ)
)
(defun WriteArea (sn / e lst pts i x y n sty)
(setq e (entget sn))
(setq lst (vl-remove-if-not
(function
(lambda (x)
(if (eq (car x) 10)
(setq pts (cons (list (cadr x) (caddr x)) pts))
)
)
)
e
)
)
(setq i 0
x 0
y 0
)
(repeat (setq n (length pts))
(setq x (+ (car (nth i pts)) x))
(setq y (+ (cadr (nth i pts)) y))
(setq i (1+ i))
)
(entmake
(list
'(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
(assoc 8 (entget sn))
(cons 10 (trans (list (/ x n) (/ y n) 0.) 1 0))
(cons
1
(strcat "Area = :"
" "
(rtos (vla-get-area (vlax-ename->vla-object sn)) 2)
" m²"
)
)
(cons 7 (getvar 'textstyle))
(cons 40
(if
(eq (cdr (assoc 40
(setq sty
(entget (tblobjname "style" (getvar 'textstyle)))
)
)
)
0.
)
(cdr (assoc 42 sty))
(cdr (assoc 40 sty))
)
)
'(71 . 5)
)
)
)
Tharwat
@Anonymous wrote:
I have many floorplans and each room has a polyline around it.
Thanks for any help!
I wrote this code for somebody else a while back.
(defun c:PolyArea (/ BitVersion acsp ss e ptList ID StrField txt p)
(vl-load-com)
(setq BitVersion
(if (> (strlen
(vl-prin1-to-string
(vlax-get-acad-object)))
40) T nil)
acsp (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)))))
(if (setq ss (ssget "_X" '((0 . "*POLYLINE")
(8 . "A-AREA-BDRY")
(-4 . "&")
(70 . 1)(410 . "Model"))))
(repeat (sslength ss)
(setq e (ssname ss 0)
sum '(0 0)
verts (cdr (assoc 90 (entget e))))
(setq ptList
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= (car x) 10))
(entget e))))
(foreach x ptList (setq sum (mapcar '+ x sum)))
(setq ID (if BitVersion
(vlax-invoke-method
(vla-get-Utility
(vla-get-ActiveDocument
(vlax-get-acad-object)))
'GetObjectIdString
(vlax-ename->vla-object
e)
:vlax-False)
(itoa (vla-get-objectid
(vlax-ename->vla-object e)))))
(setq StrField
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
ID
">%).Area \\f \"%lu2%pr2%ps[, m²]%ds44%ct8[1e-006]\">%"))
(vla-put-AttachmentPoint
(setq txt (vla-addMText
acsp
(setq p (vlax-3d-point
(mapcar '/ sum
(list verts
verts))))
0 StrField))
acAttachmentPointMiddleCenter)
(vla-put-InsertionPoint txt p)
(ssdel e ss)
)(princ "\0 Objects found:"))
(princ)
)
This is the setup he had:
Polylines for area falls under one layer "A-AREA-BDRY"
Closed polylines (bit 1 or 129)
Text height from TEXTSIZE system variable
Layer for mtext is current layer
Units are decimal meters
Not sure if this will work for you. Dotn have time to modify it for now.
HTH
@Tharwat
You left out a vital piece of information on your code. FIELD VALUE
@pbejse wrote:
................. acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))) ....
......
(410 . "Model")
@Tharwat
You left out a vital piece of information on your code. FIELD VALUE
Opps , my bad with quick reading .
Adding the DXF code 410 would kill the function *vla-get-avtivelayout* for Paperspace layouts
Thanks
@_Tharwat wrote:Adding the DXF code 410 would kill the function *vla-get-avtivelayout* for Paperspace layouts
Thanks
Thats a funny way to describe it tharwat , I guess the guy i wrote the code always use this on model space otherwise he would have complained by now 😄
But you're right, there are three different ways to i know of to avoid that.
Its either we prevent the code from running if its not on the model space.
(not (zerop (getvar 'Tilemode))
or, Force the space to model
(setq acsp (vla-get-modelspace (vla-get-activedocument
(vlax-get-acad-object))))
or, Run the code anyway regardless what space you are on now.[inside repeat, as it will depend on the selected polyline] and remove 410 on the ssget filter
(setq acsp
(vla-ObjectIDtoObject
(vla-get-activedocument
(vlax-get-acad-object))
(vla-get-OwnerID (vlax-ename->vla-object e))))
(vlax-get-acad-object))))
There are advantages and disadvantages whatever the approach is.
Good catch tharwat.
To the OP.
Change this:
(setq BitVersion
(if (> (strlen
(vl-prin1-to-string
(vlax-get-acad-object)))
40) T nil)
acsp (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)))))
To this:
(setq BitVersion
(if (> (strlen
(vl-prin1-to-string
(vlax-get-acad-object)))
40) T nil)
acsp (vla-get-modelspace (vla-get-activedocument
(vlax-get-acad-object))))
HTH
@stevesfr wrote:How to report area as sq units ?
TIA, Steve
What will happen if you chage this:
(setq ID (if BitVersion (vlax-invoke-method
(vla-get-Utility
(vla-get-ActiveDocument
(vlax-get-acad-object)))
'GetObjectIdString
(vlax-ename->vla-object
e)
:vlax-False)
(itoa (vla-get-objectid
(vlax-ename->vla-object e)))))
to this
(setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e))))
EDIT: thats the anser to your orignal question:
What do you mean by Sq. units? Engineering units? like SQ. FT?
@stevesfr wrote:If I have to determine an area, the drawing is always in feet. Details can be anything else including NTS.
but with the program, original and revised, answer is coming out 0,00
why the comma ? and I can't get it to report the numerical area of the polygon. must have a setting set wrong somewhere, but still doesn't work in a clean drawing with layer set correctly.
TIA for your help
S
(setq StrField (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
ID
">%).Area \\f \"%lu2%pr2%ps[, SQ. FT.]%ct8[0.0069444]%th44\">%"))
What about your other query? Have you resolve that yet?
@stevesfr wrote:pbejse, thanks for sticking with this dummy, all will be fine as soon as I figure out how to multiply the result by 144, because as I stated, I draw in feet not inches. This assumes the drawing is in inches.
">%).Area \\f \"%lu2%pr2%ps[, SQ. FT.]%ct8[0.0069444]%th44\">%"))
Steve
No worries stevesfr,
Here, try this:
">%).Area \\f \"%lu2%pr2%ps[, SQ. FT.]%th44\">%"
Returns 36.00 SQ. FT. for 6x6 units
@stevesfr wrote:I am grateful for all the help and guidance herein. Thx again
steve
Good for you stevesfr . Now if you want to play around with the filed code,
Edit an MTEXT/TEXT insert a field value then use this (vla-fieldcode (vlax-ename->vla-object (car (entsel))))
to see the syntax and change the code to your liking.
Cheers
@Anonymous wrote:Again, thanks for all the help!
For bonus points, could you make the script ask if you want to do all the polylines (as now), or multiple (so you select the ones you want)?
I often have to add new polylines to a drawing and deleting all the text and re-running the script seems silly...
Thanks,
Clare
Bonus huh? 
Command: polyarea
Process All Polylines [Yes/No]: Y
Command: polyarea
Process All Polylines [Yes/No]: N <-- will prompt you to select the polylines :<--- plural /multiple /many many.. 🙂
See attached
D'oh, forgot to change the layer name in the script!
It's now working perfectly!
Have some bonus points... If you draw lines between them, you can make a plane...
@Anonymous wrote:D'oh, forgot to change the layer name in the script!
It's now working perfectly!
Have some bonus points... If you draw lines between them, you can make a plane...
Hold on clareselley, bonus points is fine really. but as not to make this topic drag for more than two pages. Make a list of what else do you need . Take your time and think about it.
For the plane thingy, what is that? a textbox? a wipeout?
Remember, make a list.. I'll be here. 🙂
Cheers
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
