LENGTH and area of many polylines

[marijan.marsic]

I have many polylines in drawing, is it possible to write length and area of every single polyline on them, as text value.

Thanks...

Marijan

[ccowgill]

I have many polylines in drawing, is it possible to write length and area of every single polyline on them, as text value.

Thanks...

Marijan
simple answer, yes. The solution however, is a bit more complicated. First you need to select all the objects, and then look at the length and area properties of each one, creating a piece of text that contains this information. where would you like the text to appear, at the start, midpoint or end of the object? does it need to be rotated to match the polyline at that point, or can it be at any angle. does it need to be on the object? what type of precession do you need?

[marijan.marsic]

Thak you for your answer!

-where would you like the text to appear, at the start, midpoint or end of the object?
Lets say mid point,or somewhere not far from polyline, because there is great number
of them, so midpoint is good solution.


_does it need to be rotated to match the polyline at that point, or can it be at any angle.
Any angle, because i export this to excell,... so any angle


_does it need to be on the object?
Its good solution because there is great number
of polylines,..

_what type of precession do you need?
type of precession,... four decimal spaces for area and length

Thanks,...

Marijan

[ccowgill]

Thak you for your answer!

-where would you like the text to appear, at the start, midpoint or end of the object?
Lets say mid point,or somewhere not far from polyline, because there is great number
of them, so midpoint is good solution.


_does it need to be rotated to match the polyline at that point, or can it be at any angle.
Any angle, because i export this to excell,... so any angle


_does it need to be on the object?
Its good solution because there is great number
of polylines,..

_what type of precession do you need?
type of precession,... four decimal spaces for area and length

Thanks,...

Marijan
What format do you need the text to appear in for exporting to excel? You can give this a shot and see if gets you started in the right direction, obviously it isnt taylor-made for your situation, but if you can do any modifying, it should give you a very good start:

(defun c:lengthareatext (/ lengthmode object
objchk listobj vlobj
MidPoint Param startpline
endpline vlobjlen1 angle1
Ang TH vlobjang
textobj1 textobj2 vlobjang1
vlobjang2 lengthscale
)
(setq
lengthscale (atoi (vl-string-left-trim ":" (vl-string-left-trim "1234567890" (getvar "cannoscale"))))
) ;_ end of setq

(while (setq listobj (ssname object 0))
(setq vlobj (vlax-ename->vla-object listobj))
(if (/= (cdr (assoc 0 (entget listobj))) "ARC")
(setq vlobjlen1 (vla-get-length vlobj)
objchk 1
) ;_ end of setq
(setq vlobjlen1 (vla-get-arclength vlobj)
objchk 2
) ;_ end of setq
) ;_ end of if
(setq MidPoint (vlax-curve-getpointatdist
vlObj
(/ vlobjlen1 2)
) ;_ end of vlax-curve-getpointatdist
Param (vlax-curve-getParamAtPoint VlObj MidPoint)
startpline (vlax-curve-getStartParam VlObj)
endpline (vlax-curve-getEndParam VlObj)
angle1 (vlax-curve-getFirstDeriv
VlObj
(/ (- endpline startpline) 2)
) ;_ end of vlax-curve-getFirstDeriv
TH (* 0.08 lengthscale)
) ;_ end of setq
(if (= objchk 1)
(progn
(if (equal (car angle1) 0.0 0.01)
(setq Ang (/ pi 2))
(setq Ang (atan (/ (cadr angle1) (car angle1)))))
(setq
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
)
(setq
Ang (- (/ (+ (vla-get-endangle vlobj)
(vla-get-startangle vlobj)
) ;_ end of +
2
) ;_ end of /
(/ pi 2)
) ;_ end of -
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
) ;_ end of if
(if (wcmatch (rtos vlobjlen1 2 4) "*`.*")
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) "'"))
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) ".0000'"))
)
(setq textObj1 (vla-addtext
acadModelSpace
(strcat vlobjlen " " (vla-get-area vlobj))
(vlax-3d-point Midpoint)
TH
) ;end vla-addtext
) ;end setq


(vla-put-color textobj1 256) ;change color
(vla-put-alignment textobj1 13) ;change justification
(vla-put-textalignmentpoint
textobj1
(vlax-3d-point Midpoint)
) ;_ end of vla-put-textalignmentpoint
;change insetion point
(vla-put-rotation textobj1 Ang)
;change rotation
(vla-put-layer textobj1 "Annotation")
(if (/= textObj2 nil)
(progn
(vla-put-color textobj2 256)
(vla-put-alignment textobj2 13)
(vla-put-textalignmentpoint
textobj2
(vlax-3d-point
(list (+ (car Midpoint) (* (sin ang) (* 0.16 lengthscale)))
(- (cadr Midpoint) (* (cos ang) (* 0.16 lengthscale)))
(caddr Midpoint)
) ;_ end of list
) ;_ end of vlax-3d-point
) ;_ end of vla-put-textalignmentpoint
(vla-put-rotation textobj2 Ang)
(vla-put-layer textobj2 "Annotation")
) ;_ end of progn
) ;_ end of if
(ssdel listobj object)
) ;end while
) ;end defun


I havent tested it, it may not even work, and it is currently set up to use our office standards

[marijan.marsic]

HI!!
Thank You for instant reply!

I have try it but there is error at startin the app

acad command line: Command: lengthareatext
; error: bad argument type: lselsetp nil

Thanks anyway!!

Marijan

[ccowgill]

HI!!
Thank You for instant reply!

I have try it but there is error at startin the app

acad command line: Command: lengthareatext
; error: bad argument type: lselsetp nil

Thanks anyway!!

Marijan
well I have fixed all the errors, but I dont think the rotation for the text is working
(defun c:lengthareatext (/ lengthmode object
objchk listobj vlobj
MidPoint Param startpline
endpline vlobjlen1 angle1
Ang TH vlobjang
textobj1 textobj2 vlobjang1
vlobjang2 lengthscale vlobjarea1
)
(setq
object
(ssget
(list
(cons 0
"POLYLINE,*CONTOUR,ARC,LINE,LWPOLYLINE,2DPOLYLINE"
) ;_ end of cons
) ;_ end of list
) ;_ end of ssget
lengthscale (atoi (vl-string-left-trim ":" (vl-string-left-trim "1234567890" (getvar "cannoscale"))))
) ;_ end of setq

(while (setq listobj (ssname object 0))
(setq vlobj (vlax-ename->vla-object listobj))
(if (/= (cdr (assoc 0 (entget listobj))) "ARC")
(setq vlobjlen1 (vla-get-length vlobj)
vlobjarea1 (rtos (vla-get-area vlobj) 2 4)
objchk 1
) ;_ end of setq
(setq vlobjlen1 (vla-get-arclength vlobj)
objchk 2
) ;_ end of setq
) ;_ end of if
(setq MidPoint (vlax-curve-getpointatdist
vlObj
(/ vlobjlen1 2)
) ;_ end of vlax-curve-getpointatdist
Param (vlax-curve-getParamAtPoint VlObj MidPoint)
startpline (vlax-curve-getStartParam VlObj)
endpline (vlax-curve-getEndParam VlObj)
angle1 (vlax-curve-getFirstDeriv
VlObj
(/ (- endpline startpline) 2)
) ;_ end of vlax-curve-getFirstDeriv
TH (* 0.08 lengthscale)
) ;_ end of setq
(if (= objchk 1)
(progn
(if (equal (car angle1) 0.0 0.01)
(setq Ang (/ pi 2))
(setq Ang (atan (/ (cadr angle1) (car angle1)))))
(setq
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
)
(setq
Ang (- (/ (+ (vla-get-endangle vlobj)
(vla-get-startangle vlobj)
) ;_ end of +
2
) ;_ end of /
(/ pi 2)
) ;_ end of -
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
) ;_ end of if
(if (wcmatch (rtos vlobjlen1 2 4) "*`.*")
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) "'"))
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) ".0000'"))
)
(setq textObj1 (vla-addtext
acadModelSpace
(strcat vlobjlen " " vlobjarea1)
(vlax-3d-point Midpoint)
TH
) ;end vla-addtext
) ;end setq


(vla-put-color textobj1 256) ;change color
(vla-put-alignment textobj1 13) ;change justification
(vla-put-textalignmentpoint
textobj1
(vlax-3d-point Midpoint)
) ;_ end of vla-put-textalignmentpoint
;change insetion point
(vla-put-rotation textobj1 Ang)
;change rotation
(vla-put-layer textobj1 "0")
(if (/= textObj2 nil)
(progn
(vla-put-color textobj2 256)
(vla-put-alignment textobj2 13)
(vla-put-textalignmentpoint
textobj2
(vlax-3d-point
(list (+ (car Midpoint) (* (sin ang) (* 0.16 lengthscale)))
(- (cadr Midpoint) (* (cos ang) (* 0.16 lengthscale)))
(caddr Midpoint)
) ;_ end of list
) ;_ end of vlax-3d-point
) ;_ end of vla-put-textalignmentpoint
(vla-put-rotation textobj2 Ang)
(vla-put-layer textobj2 "0")
) ;_ end of progn
) ;_ end of if
(ssdel listobj object)
) ;end while
) ;end defun

[marijan.marsic]

OOOOPS!!!
again!
..............................................................................................

APPLOAD lengthareatext.lsp successfully loaded.
Command:
Command:
Command: lengthareatext
Select objects: 1 found
Select objects:
; error: bad argument type: VLA-OBJECT nil
Command:
Command: LENGTHAREATEXT
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects: ; error: bad argument type: VLA-OBJECT nil
Command:

[ccowgill]

I just ran it on my system and here is the output:

Command:
Command: LENGTHAREATEXT
Select objects: 1 found

Select objects:
<Selection set: 82>

Command:

You probably need to add (VL-LOAD-COM) to the beginning of the code. My office has this line in our main load file, so I always forget to put it in on individual programs.

[marijan.marsic]

Hi!

Again;

Command: LENGTHAREATEXT
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects: 1 found, 3 total
Select objects: ; error: bad argument type: VLA-OBJECT nil

maybe is acad version, i work with 2008,..

[devitg.89838]

I just ran it on my system and here is the output:

You probably need to add (VL-LOAD-COM) to the beginning of the code. My office has this line in our main load file, so I always forget to put it in on individual programs.


Seem to be it need it too


(setq acad* (vlax-get-acad-object))
(setq adoc (vla-get-activedocument acad*))

(setq acadModelSpace (vla-get-modelspace adoc))

[kennet.sjoberg]

I have many polylines in drawing, is it possible to write length and area of every single polyline on them, as text value.

Thanks...

Marijan

A shorter way to bring the water. . .

(defun c:test ( / Item SelSet Ent Vl-Obj )
(vl-load-com)
(command "_.UNDO" "BEgin" )
(setq Item 0 )
(if (setq SelSet (ssget "_X" '((0 . "*POLYLINE"))) )
(while (setq Ent (ssname SelSet Item ))
(setq Vl-Obj (vlax-ename->vla-Object Ent ) )
(command "._text" "J" "MC"
(vlax-curve-getPointAtParam Vl-Obj (/ (vlax-curve-getEndParam Vl-Obj ) 2.0 ) )
"" ; Default height
"" ; Default rotation
(strcat "Area: " (rtos (vlax-get Vl-Obj "Area" ) 2 4 ) " ; Length: " (rtos (vlax-get Vl-Obj "Length" ) 2 4 ))
)
(setq Item (1+ Item ))
)
(princ "..no polylines found." )
)
(if (< 0 Item ) (princ (strcat "\n" (itoa Item ) " polylines treated. You can undo with Command: U" )) ( ) )
(command "._UNDO" "End" )
(princ)
)


: ) Happy Computing !

kennet

[ccowgill]

Seem to be it need it too


(setq acad* (vlax-get-acad-object))
(setq adoc (vla-get-activedocument acad*))

(setq acadModelSpace (vla-get-modelspace adoc))yes, you are right, we have our code set as a global variable, and I always forget that I need to include the definitions.

[marijan.marsic]

HI!
Here is the code:
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
(defun c:lengthareatext (/ lengthmode object
objchk listobj vlobj
MidPoint Param startpline
endpline vlobjlen1 angle1
Ang TH vlobjang
textobj1 textobj2 vlobjang1
vlobjang2 lengthscale vlobjarea1
)
(VL-LOAD-COM)
(setq acad* (vlax-get-acad-object))
(setq adoc (vla-get-activedocument acad*))

(setq acadModelSpace (vla-get-modelspace adoc))
(setq
object
(ssget
(list
(cons 0
"POLYLINE,*CONTOUR,ARC,LINE,LWPOLYLINE,2DPOLYLINE"
) ;_ end of cons
) ;_ end of list
) ;_ end of ssget
lengthscale (atoi (vl-string-left-trim ":" (vl-string-left-trim "1234567890" (getvar

"cannoscale"))))
) ;_ end of setq

(while (setq listobj (ssname object 0))
(setq vlobj (vlax-ename->vla-object listobj))
(if (/= (cdr (assoc 0 (entget listobj))) "ARC")
(setq vlobjlen1 (vla-get-length vlobj)
vlobjarea1 (rtos (vla-get-area vlobj) 2 4)
objchk 1
) ;_ end of setq
(setq vlobjlen1 (vla-get-arclength vlobj)
objchk 2
) ;_ end of setq
) ;_ end of if
(setq MidPoint (vlax-curve-getpointatdist
vlObj
(/ vlobjlen1 2)
) ;_ end of vlax-curve-getpointatdist
Param (vlax-curve-getParamAtPoint VlObj MidPoint)
startpline (vlax-curve-getStartParam VlObj)
endpline (vlax-curve-getEndParam VlObj)
angle1 (vlax-curve-getFirstDeriv
VlObj
(/ (- endpline startpline) 2)
) ;_ end of vlax-curve-getFirstDeriv
TH (* 0.08 lengthscale)
) ;_ end of setq
(if (= objchk 1)
(progn
(if (equal (car angle1) 0.0 0.01)
(setq Ang (/ pi 2))
(setq Ang (atan (/ (cadr angle1) (car angle1)))))
(setq
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
)
(setq
Ang (- (/ (+ (vla-get-endangle vlobj)
(vla-get-startangle vlobj)
) ;_ end of +
2
) ;_ end of /
(/ pi 2)
) ;_ end of -
vlobjang (angtos Ang 4 3)
vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
vlobjang2 (vl-string-right-trim "d" vlobjang2)
vlobjang (strcat vlobjang2 "%%" vlobjang1)
) ;_ end of setq
) ;_ end of if
(if (wcmatch (rtos vlobjlen1 2 4) "*`.*")
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) "'"))
(setq vlobjlen (strcat (rtos vlobjlen1 2 4) ".0000'"))
)
(setq textObj1 (vla-addtext
acadModelSpace
(strcat vlobjlen " " vlobjarea1)
(vlax-3d-point Midpoint)
TH
) ;end vla-addtext
) ;end setq


(vla-put-color textobj1 256) ;change color
(vla-put-alignment textobj1 13) ;change justification
(vla-put-textalignmentpoint
textobj1
(vlax-3d-point Midpoint)
) ;_ end of vla-put-textalignmentpoint
;change insetion point
(vla-put-rotation textobj1 Ang)
;change rotation
(vla-put-layer textobj1 "0")
(if (/= textObj2 nil)
(progn
(vla-put-color textobj2 256)
(vla-put-alignment textobj2 13)
(vla-put-textalignmentpoint
textobj2
(vlax-3d-point
(list (+ (car Midpoint) (* (sin ang) (* 0.16 lengthscale)))
(- (cadr Midpoint) (* (cos ang) (* 0.16 lengthscale)))
(caddr Midpoint)
) ;_ end of list
) ;_ end of vlax-3d-point
) ;_ end of vla-put-textalignmentpoint
(vla-put-rotation textobj2 Ang)
(vla-put-layer textobj2 "0")
) ;_ end of progn
) ;_ end of if
(ssdel listobj object)
) ;end while
) ;end defun
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

when i try them in acad 2009
here is the command line;

C:LENGTHAREATEXT
Command: LENGTHAREATEXT
Select objects: Specify opposite corner: 0 found
Select objects: Specify opposite corner: 4 found
Select objects:
*Cancel*
Automation Error. Invalid input

I do not know what is wrong now!!!???

Thank you for your effort!!!

[marijan.marsic]

A shorter way to bring the water. . .

(defun c:test ( / Item SelSet Ent Vl-Obj )
(vl-load-com)
(command "_.UNDO" "BEgin" )
(setq Item 0 )
(if (setq SelSet (ssget "_X" '((0 . "*POLYLINE"))) )
(while (setq Ent (ssname SelSet Item ))
(setq Vl-Obj (vlax-ename->vla-Object Ent ) )
(command "._text" "J" "MC"
(vlax-curve-getPointAtParam Vl-Obj (/ (vlax-curve-getEndParam Vl-Obj ) 2.0 ) )
"" ; Default height
"" ; Default rotation
(strcat "Area: " (rtos (vlax-get Vl-Obj "Area" ) 2 4 ) " ; Length: " (rtos (vlax-get Vl-Obj "Length" ) 2 4 ))
)
(setq Item (1+ Item ))
)
(princ "..no polylines found." )
)
(if (< 0 Item ) (princ (strcat "\n" (itoa Item ) " polylines treated. You can undo with Command: U" )) ( ) )
(command "._UNDO" "End" )
(princ)
)


: ) Happy Computing !

kennet

THANK YOU!!!!
IT WORKS!!!!!

Thank you for your effort!!

[irneb]

A shorter way to bring the water. . .Isn't it just STRANGE how certain things are just SOOOO much simpler when using ActiveX?:mrgreen: Then other things become just painful going through a whole set of vla calls?:shock:

Trick is to figure out which is the best (or rather shortest) option for the scenario.

[kennet.sjoberg]

THANK YOU!!!!
IT WORKS!!!!!

Thank you for your effort!!
Are you surprised :?:

I'm glad if I helped you

: ) Happy Computing !

kennet 8)

[marijan.marsic]

Are you surprised :?:

I'm glad if I helped you

: ) Happy Computing !

kennet 8)

Are you surprised :?:
Yes!!!
It so small peace of code,,,,
but very effective,....

Thank You Again!!