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