data table of closed polyline that includes coordinates, line lengths and angles.

[uips]

Hello ,

 

I need help with automatic my work and i wonder if its possible wiht lisp.

 

I need to analyze a closed polyline and gather information of the drawing.

 

Theres a drawing in attachment how it should look like. The closed polyline is the red outer line and Cyan circle blocks on the corners are the Coordinate points.

 

Is it possible ot write programm with lisp or any other programming feature to doi t for me other than i checking every point length and angle manually and then filling in the table one by one.

 

FOr example if i have a square 1x1 meter square in autocad.I want autocad to automaticaly give me tabkle of 4 points that show COordinates X and Y of each point, angle 90 degrees for each corner and line length 1 meter behind each point. There are usualy a lot of scatter on the drawin i should be able to select og wihc closed polyline i want to analyze.

 

I hope someone will help me with the script/macro/commanding or give me hints where is hould start myself and if its good idea to try with lisp or should i try somethign else.

[Lee Mac]

This program will get you most of the way there: Polyline Information

[uips]

Thank you, that works good for coordinates and lengths.

 

I also found this post, Theres a working .lsp with coordinates.

http://www.cadtutor.net/forum/showthread.php?25192-generate-X-amp-Y-coordinates-into-table

 

Now last thing that is missing is the angles inside polyline.

 

If i could do all that it one click and wiht one lisp it would be more than perfect

[uips]

I found some codes for polyline angles

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-polyline-angles/td-p/3018908

 

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-included-angles-of-pline/m-p/2847672/highlight/true#M293442

 

I dont know how to do the coding but i would be so thankful if someone would merge those codes into one that would give me a result that is shown on the picture in my first post

[Tharwat]

Hi,

 

You want the angle values in Radians or Degrees?

[uips]

In degrees with a precision of minutes. coordinates with precision 0.00 and lengths wiht 0.00 aswell in meters.

 

I need to get the tabel as shown in the picture, the easiest way possible.

 

In the start i have blank page with bunch of coordinates, creating polyline of the coordiantes i want to analyze seems the easiest way to do it, with a proper code.

[Tharwat]

Try this;

 

(defun c:Test (/ hgt s l a n l1 lst p r c tbl)
 ;; Tharwat 11.Mar.2016 ;;
 (if
   (and
     (setq s (car (entsel "\nSelect closed Polyline :")))
     (if (and (eq (cdr (assoc 00 (entget s))) "LWPOLYLINE")
              (eq (cdr (assoc 70 (entget s))) 1)
         )
       (progn
         (setq l   (mapcar
                     'cdr
                     (vl-remove-if-not
                       '(lambda (p) (= (car p) 10))
                       (entget s)
                     )
                   )
               a   (car l)
               n   1
               hgt
                   (cdr
                     (assoc
                       40
                       (entget
                         (cdr
                           (cadr
                             (member
                               (cons 3 (getvar 'CTABLESTYLE))
                               (dictsearch (namedobjdict) "ACAD_TABLESTYLE")
                             )
                           )
                         )
                       )
                     )
                   )
         )
         (foreach x (cdr l)
           (setq l1  (list (if (> 10 n)
                             (strcat "0" (itoa n))
                             (itoa n)
                           )
                           (rtos (car x) 2 2)
                           (rtos (cadr x) 2 2)
                           (rtos (/ (* (angle a x) 180.0) pi) 2 2)
                           (rtos (distance a x) 2 2)
                     )
                 n   (1+ n)
                 a   x
                 lst (cons l1 lst)
           )
         )
         (setq lst (append
                     (list
                       (list (if (> 10 n)
                               (strcat "0" (itoa n))
                               (itoa n)
                             )
                             (rtos (caar l) 2 2)
                             (rtos (cadr (car l)) 2 2)
                             (rtos (/ (* (angle (car l) (last l)) 180.0) pi)
                                   2
                                   2
                             )
                             (rtos (distance (car l) (last l)) 2 2)
                       )
                     )
                     lst
                   )
               lst (reverse lst)
         )
       )
       (progn
         (alert
           "\nSelected object is either not LWpolyline or not closed !"
         )
         nil
       )
     )
     (setq p (getpoint "\nTable location :"))
     (setq r   2
           c   -1
           tbl (vla-addtable
                 (vla-get-block
                   (vla-get-activelayout
                     (vla-get-activedocument
                       (vlax-get-acad-object)
                     )
                   )
                 )
                 (vlax-3d-point p)
                 (+ 2 (length lst))
                 5
                 (* hgt 250.)
                 (* hgt 1000.)
               )
     )
   )
    (progn
      (vla-unmergecells tbl 0 0 0 0)
      (vla-setcolumnwidth tbl 0 (* hgt 400.))
      (mapcar '(lambda (r1 r2 c1 c2) (vla-mergecells tbl r1 r2 c1 c2))
              '(0 0 0 0)
              '(1 0 1 1)
              '(0 1 3 4)
              '(0 2 3 4)
      )
      (mapcar '(lambda (r c s) (vla-settext tbl r c s))
              '(0 0 0 0 1 1)
              '(0 1 3 4 1 2)
              '("Point \\PNo."
                "Coordinates"
                "Angles \\P(Deg.)"
                "Lengths \\P(m)"
                "X"
                "Y"
               )
      )
      (mapcar '(lambda (row)
                 (vla-setrowheight tbl r (* hgt 250.))
                 (mapcar '(lambda (st)
                            (vla-settext tbl r (setq c (1+ c)) st)
                            (vla-setcellalignment tbl r c acMiddleCenter)
                          )
                         row
                 )
                 (setq r (1+ r)
                       c -1
                 )
               )
              lst
      )
    )
 )
 (princ)
)(vl-load-com)

[uips]

Thank you, the table is formin exactly as i want it to, only the fonts are too small and the size of table was too big but i guess its easily adjustable if u can refer to me what variables in the code to change.

 

It gets a little messy in angles section. If i use this command on rectangle, it will display corners 0; 270; 180; 270, but it should look like 90; 90; 90; 90 . Would it be possible to make the code collect all the inside corners of the polyline.?

 

Thank you for helping

[Tharwat]

You are welcome.

 

To adjust the font size you should adjust your current table style then the program would following the setting of that table.

 

Regarding the angles , the program takes the angle of each segment and not the internal angles between between tow segments.

[uips]

Thanks, i hope someone can edit the code to collect internal angles. All the other things are working perfectly

[marko_ribar]

You can try this code... It'll create *.csv excel file... You can then insert table into CAD as OLE object... On the other hand if you wish TABLE entity, modify Lee's or Tharwat's code to include angles... You can skin angles info from my link :

 

Click here...

 

HTH, M.R.

Edited March 11, 2016 by marko_ribar

[uips]

hey with rebar codei get the result of 0 ; 270; 180; 90 for the angles. but i need it to be 90 for each corner. The angle should be calcualted from 2 lines that connect in the current point. Manually i do it wiht measuregem command.

[marko_ribar]

hey with rebar codei get the result of 0 ; 270; 180; 90 for the angles. but i need it to be 90 for each corner. The angle should be calcualted from 2 lines that connect in the current point. Manually i do it wiht measuregem command.

 

You can do it and with rebar code, you'll just have to subtract each segment pair for desired vertex... Assuming that you want them all, use (mapcar '(lambda ( a b ) (- b a)) (getangles (getvertices objSelection)) (cdr (reverse (cons (car (getangles (getvertices objSelection))) (reverse (getangles (getvertices objSelection)))))) )... I only showed you syntax from my mind, but you can really use functions from rebar code... I think that (getangles (getvertices objSelection)) = lstReturn2 from rebar code...

[uips]

Im not familiar with any programming and coding so it would take enormous amout of time to figure out how to make this work correctly for me. You possibly make the code work in the way i need and post it

[marko_ribar]

If it means something to you...

 

(defun c:angcllw ( / unit v^v listclockwise-p lw lwo vertl vertlo angl f fn n )

 (vl-load-com)

 (defun unit ( v )
   (if (not (equal v '(0.0 0.0 0.0) 1e-6))
     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
   )
 )

 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
     (- (* (caddr u) (car v)) (* (car u) (caddr v)))
     (- (* (car u) (cadr v)) (* (cadr u) (car v)))
   )
 )

 (defun listclockwise-p ( lst / z vlst )
   (vl-catch-all-apply 'minusp 
     (list
       (if 
         (not 
           (equal 0.0
             (setq z
               (apply '+
                 (mapcar 
                   (function
                     (lambda ( u v )
                       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                     )
                   )
                   (setq vlst
                     (mapcar
                       (function
                         (lambda ( a b ) (mapcar '- b a))
                       )
                       (mapcar (function (lambda ( x ) (car lst))) lst) 
                       (cdr (reverse (cons (car lst) (reverse lst))))
                     )
                   )
                   (cdr (reverse (cons (car vlst) (reverse vlst))))
                 )
               )
             ) 1e-6
           )
         )
         z
         (progn
           (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
           nil
         )
       )
     )
   )
 )

 (setq lw (car (entsel "\nPick closed LWPOLYLINE with straight segments only...")))
 (while (or (not lw) (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (not (vl-every 'zerop (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))) (and (/= (cdr (assoc 70 (entget lw))) 1) (/= (cdr (assoc 70 (entget lw))) 129)))
   (prompt "\nMissed or picked wrong entity type... Try picking closed LWPOLYLINE with straight segments only again...")
   (setq lw (car (entsel "\nPick closed LWPOLYLINE with straight segments only...")))
 )
 (setq vertl
   (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) 
     (mapcar 'cdr 
       (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) 
         (entget lw)
       )
     )
   )
 )
 (if (equal (car vertl) (last vertl) 1e-6)
   (setq vertl (reverse (cdr (reverse vertl))))
 )
 (setq lwo (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) 0.001))))))
 (setq vertlo 
   (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lwo)))) lwo 0)) 
     (mapcar 'cdr 
       (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) 
         (entget lwo)
       )
     )
   )
 )
 (if (equal (car vertlo) (last vertlo) 1e-6)
   (setq vertlo (reverse (cdr (reverse vertlo))))
 )
 (setq angl
   (mapcar '(lambda ( an ) (cvunit an "radian" "degree"))
     (mapcar '(lambda ( a b c d / z ang1 ang2 )
       (progn
         (setq z (unit (v^v (mapcar '- a b) (mapcar '- c b))))
         (setq ang1
           (if (> (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
             (- (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
             (- (+ (* 2 pi) (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z))))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           )
         )
         (setq ang2
           (if (> (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
             (- (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
             (- (+ (* 2 pi) (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z))))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           )
         )
         (if (> ang2 pi)
           (setq ang2 (- (* 2 pi) ang2))
         )
         (if (> ang2 (/ pi 2))
           (setq ang1 (- (* 2 pi) ang1))
         )
         (if (listclockwise-p (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw))))
           ang1
           (- (* 2 pi) ang1)
         )
       ))
       (cons (last vertl) (reverse (cdr (reverse vertl)))) 
       vertl 
       (cdr (reverse (cons (car vertl) (reverse vertl)))) 
       vertlo
     )
   )
 )
 (setq f (open (setq fn (strcat (getvar 'dwgprefix) (getvar 'dwgname) ".csv")) "w"))
 (setq n 0)
 (write-line "" f)
 (write-line "Vertex,X,Y,Z,Angle" f)
 (mapcar '(lambda ( a b ) (write-line (strcat (itoa (setq n (1+ n))) "," (rtos (car a) 2 50) "," (rtos (cadr a) 2 50) "," (rtos (caddr a) 2 50) "," (rtos b 2 50)) f))
   vertl 
   angl
 )
 (close f)
 (entdel lwo)
 (startapp "EXPLORER" fn)
 (princ)
)

Edited March 14, 2016 by marko_ribar
code changed...

[uips]

Angles are working perfectly in the last code, exactly what i was looking for.

 

Is it possible replace the angle code in Tharwat test With the one in angcllw, or make changes in your last code. I only need X and y coordinate with precision 0.00, angles with precision of minutes and lenghts wiht precision 0.00 meters. Could it send the the data directly into right columns in excel?.Possibly a table design as close as possible to the one on the picture i posted

 

In the end i need to create report in document version and also data table on the drawing. It seems to me that easiest way would be to make excel file with the code and then i can later easily import it into Autocad drawing and copy the table into document report aswell. Ofcorse if someone has better solution id be happy to hear

[marko_ribar]

Angles are working perfectly in the last code, exactly what i was looking for.

 

Is it possible replace the angle code in Tharwat test With the one in angcllw, or make changes in your last code. I only need X and y coordinate with precision 0.00, angles with precision of minutes and lenghts wiht precision 0.00 meters. Could it send the the data directly into right columns in excel?.Possibly a table design as close as possible to the one on the picture i posted

 

In the end i need to create report in document version and also data table on the drawing. It seems to me that easiest way would be to make excel file with the code and then i can later easily import it into Autocad drawing and copy the table into document report aswell. Ofcorse if someone has better solution id be happy to hear

 

(defun c:cllw2csv ( / unit v^v listclockwise-p lw lwo vertl vertlo angl lenl f fn n )

 (vl-load-com)

 (defun unit ( v )
   (if (not (equal v '(0.0 0.0 0.0) 1e-6))
     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
   )
 )

 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
     (- (* (caddr u) (car v)) (* (car u) (caddr v)))
     (- (* (car u) (cadr v)) (* (cadr u) (car v)))
   )
 )

 (defun listclockwise-p ( lst / z vlst )
   (vl-catch-all-apply 'minusp 
     (list
       (if 
         (not 
           (equal 0.0
             (setq z
               (apply '+
                 (mapcar 
                   (function
                     (lambda ( u v )
                       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                     )
                   )
                   (setq vlst
                     (mapcar
                       (function
                         (lambda ( a b ) (mapcar '- b a))
                       )
                       (mapcar (function (lambda ( x ) (car lst))) lst) 
                       (cdr (reverse (cons (car lst) (reverse lst))))
                     )
                   )
                   (cdr (reverse (cons (car vlst) (reverse vlst))))
                 )
               )
             ) 1e-6
           )
         )
         z
         (progn
           (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
           nil
         )
       )
     )
   )
 )

 (setq lw (car (entsel "\nPick closed LWPOLYLINE with straight segments only...")))
 (while (or (not lw) (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (not (vl-every 'zerop (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))) (and (/= (cdr (assoc 70 (entget lw))) 1) (/= (cdr (assoc 70 (entget lw))) 129)))
   (prompt "\nMissed or picked wrong entity type... Try picking closed LWPOLYLINE with straight segments only again...")
   (setq lw (car (entsel "\nPick closed LWPOLYLINE with straight segments only...")))
 )
 (setq vertl
   (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) 
     (mapcar 'cdr 
       (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) 
         (entget lw)
       )
     )
   )
 )
 (if (equal (car vertl) (last vertl) 1e-6)
   (setq vertl (reverse (cdr (reverse vertl))))
 )
 (setq lwo (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) 0.001))))))
 (setq vertlo 
   (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lwo)))) lwo 0)) 
     (mapcar 'cdr 
       (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) 
         (entget lwo)
       )
     )
   )
 )
 (if (equal (car vertlo) (last vertlo) 1e-6)
   (setq vertlo (reverse (cdr (reverse vertlo))))
 )
 (setq angl
   (mapcar '(lambda ( a b c d / z ang1 ang2 )
     (progn
       (setq z (unit (v^v (mapcar '- a b) (mapcar '- c b))))
       (setq ang1
         (if (> (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           (- (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           (- (+ (* 2 pi) (angle '(0.0 0.0) (unit (mapcar '- (trans c 0 z) (trans b 0 z))))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
         )
       )
       (setq ang2
         (if (> (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           (- (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z)))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
           (- (+ (* 2 pi) (angle '(0.0 0.0) (unit (mapcar '- (trans d 0 z) (trans b 0 z))))) (angle '(0.0 0.0) (unit (mapcar '- (trans a 0 z) (trans b 0 z)))))
         )
       )
       (if (> ang2 pi)
         (setq ang2 (- (* 2 pi) ang2))
       )
       (if (> ang2 (/ pi 2))
         (setq ang1 (- (* 2 pi) ang1))
       )
       (if (listclockwise-p (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw))))
         ang1
         (- (* 2 pi) ang1)
       )
     ))
     (cons (last vertl) (reverse (cdr (reverse vertl)))) 
     vertl 
     (cdr (reverse (cons (car vertl) (reverse vertl)))) 
     vertlo
   )
 )
 (setq lenl 
   (mapcar '(lambda ( a b ) (distance a b))
     vertl
     (cdr (reverse (cons (car vertl) (reverse vertl))))
   )
 )
 (setq f (open (setq fn (strcat (getvar 'dwgprefix) (getvar 'dwgname) ".csv")) "w"))
 (setq n 0)
 (write-line "" f)
 (write-line "Vertex,X,Y,Angle,Length" f)
 (mapcar '(lambda ( a b c ) (write-line (strcat (itoa (setq n (1+ n))) "," (rtos (car a) 2 2) "," (rtos (cadr a) 2 2) "," (vl-string-translate "d" "°" (angtos b 1 2)) "," (rtos c 2 2)) f))
   vertl 
   angl
   lenl
 )
 (close f)
 (entdel lwo)
 (startapp "EXPLORER" fn)
 (princ)
)

HTH, M.R.

Edited March 14, 2016 by marko_ribar
code changed...

[uips]

Thank you so much, this is working really good.

 

I noticed slight differenses in angle. Im suppose to make the calcualtions after applying the 0.00 precision. It causes +/- 1 minute error for the angles. It should use 0.00 precision for the calculations. I assume the code calculates with exact numbes rand this is causing the slight difference in angle values.

[uips]

http://www.speedyshare.com/M7aH9/test.dwg

 

Heres the sample file that im using. Calculated values have to appear exactly the same as in the table.

[marko_ribar]

http://www.speedyshare.com/M7aH9/test.dwg

 

Heres the sample file that im using. Calculated values have to appear exactly the same as in the table.

 

uips, I haven't looked into your DWG, but unfortunately I don't believe I can correct those angle results... This reply is just to inform you that both my posted codes have slightly changed again... So use those revisions as they are more reliable...

 

M.R.

 

[EDIT : I looked into your DWG, and beside differences of 1' in angles, I see that your table has wrong coordinates : X coordinates should be Y and Y should be X... All in all my last code satisfies your request in the most tasks, so I strongly suggest that you use it and insert OLE xls file when saved from EXCEL csv as table into CAD... Look for option of linking xls file as you can easily change xls file and changes could then reflect to both xls file and dwg where xls is linked to...]

Edited March 14, 2016 by marko_ribar
edit comment