Jump to content

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


uips

Recommended Posts

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.

untitled.jpg

Link to comment
Share on other sites

  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • uips

    12

  • marko_ribar

    5

  • Tharwat

    3

  • Lee Mac

    1

Top Posters In This Topic

Posted Images

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by marko_ribar
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by marko_ribar
code changed...
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by marko_ribar
code changed...
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by marko_ribar
edit comment
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...