Lisp modification - export polyline vertices (original by Tharwat)

March 27, 2023

Hello everybody! I made some modification to a lisp of @Tharwat found on this forum (thank you Tharwat!). The modifications I made are: to add a number before each pair of coordinates (starting with a chosen number) and also to save the file automatically near the DWG with some suffix (not to open a "save as" window).

I would be grateful if anybody could help me with some new modifications:

1. To add 2 new lines at the end of the txt file: polyline area and polyline perimeter.

2. To add a column with the distance between the points

So now the output is

1,Y,X

2,Y,X

...

n,Y,X

And I would like it to be:

1,Y,X,32.76 *distance between 1 and 2

2,Y,X,35.89 *distance between 2 and 3

...

n,Y,X,50.65 *distance between n and 1

Area=500

Perimeter=200

Numbers are random. DWG should be saved for the lisp to work.

I am using ProgeCAD so some functions may not work (though 90% do) so the simplest solution (with the most basic functions) would be best.

Thank you in advance!

exppl.lsp

Edited March 27, 2023 by Radu Iordache

March 27, 2023

According to posted *.lsp...

(defun c:exppl ( / ss n nr fl op )
  ;; Tharwat. 11.May.16	;;
  ;; Modified           ;;

  (vl-load-com)

  (if (= 0 (getvar (quote dwgtitled)))
    (alert "Please, save DWG and restart routine... Quitting...")
    (progn
      (initget 6)
      (setq n (cond ( (getint "\nNumber of first point <1> : ") ) (1)))
      (princ "\nSelect polylines : ")
      (and
        (setq ss (ssget (list (cons 0 "LWPOLYLINE,POLYLINE") (cons -4 "&") (cons 70 1))))
        (setq fl (substr (getvar (quote dwgname)) 1 (- (strlen (getvar (quote dwgname))) 4)))
        (setq op (open (strcat (getvar (quote dwgprefix)) fl "_exppl.txt") "w"))
        (progn
          ( (lambda ( i / sn p as pp )
              (while (setq sn (ssname ss (setq i (1+ i))))
                (if (not nr)
                  (setq nr n)
                )
                (mapcar 
                  (function (lambda ( x )
                    (and
                      (= (car x) 10)
                      (setq p (cdr x))
                      (if (setq as (assoc 10 (cdr (member x (entget sn)))))
                        (setq pp (cdr as))
                        (setq pp (cdr (assoc 10 (entget sn))))
                      )
                      (write-line (strcat (itoa nr) "," (rtos (cadr p) 2 3) "," (rtos (car p) 2 3) "," (rtos (distance p pp) 2 3)) op)
                      (setq nr (1+ nr))
                    )
                  ))
                  (entget sn)
                )
                (write-line (strcat "Area = " (rtos (vlax-curve-getarea sn) 2 3)) op)
                (write-line (strcat "Perimeter = " (rtos (vlax-curve-getdistatparam sn (vlax-curve-getendparam sn)) 2 3)) op)
                (write-line "" op)
              )
            )
            -1
          )
          (close op)
        )
      )
    )
  )
  (princ)
)

HTH.

M.R.

Edited March 28, 2023 by marko_ribar

March 27, 2023

Something like this ?

(defun c:exppl (/ ss fl op)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (initget 6)
  (or (setq nr (getint "\nNumber of first point <1>:"))
      (setq nr 1)
  )
  (princ "\nSelect polyline:")
  (and
    (setq ss (ssget ":S" '((0 . "LWPOLYLINE,POLYLINE"))))
    (setq fl (substr (getvar "dwgname")
                     1
                     (- (strlen (getvar "dwgname")) 4)
             )
    )
    (setq op (open (strcat (getvar "dwgprefix") fl "_exppl.txt") "w"))
    (progn
      ((lambda (i / sn p d)
         (while (setq sn (ssname ss (setq i (1+ i))))
           (mapcar
             '(lambda (x)
                (and (= (car x) 10)
                     (or (and p (setq d (distance p (setq p (cdr x)))))
                         (setq p (cdr x))
                     )
                     (write-line
                       (strcat (itoa nr)
                               ","
                               (rtos (cadr p) 2 3)
                               ","
                               (rtos (car p) 2 3)
                               (if d
                                 (strcat "," (rtos d 2 3))
                                 ""
                               )
                       )
                       op
                     )
                     (setq nr (1+ nr))
                )
              )
             (entget sn)
           )
           (foreach itm (list (list "Perimeter = "
                                    (vlax-curve-getdistatparam
                                      sn
                                      (vlax-curve-getendparam sn)
                                    )
                              )
                              (list "Area = " (vlax-curve-getarea sn))
                        )
             (write-line (strcat (car itm) (rtos (cadr itm) 2 3)) op)
           )
         )
       )
        -1
      )
      (close op)
    )
  )
  (princ)
)

March 27, 2023

43 minutes ago, Tharwat said:

Something like this ?

(defun c:exppl (/ ss fl op)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (initget 6)
  (or (setq nr (getint "\nNumber of first point <1>:"))
      (setq nr 1)
  )
  (princ "\nSelect polyline:")
  (and
    (setq ss (ssget ":S" '((0 . "LWPOLYLINE,POLYLINE"))))
    (setq fl (substr (getvar "dwgname")
                     1
                     (- (strlen (getvar "dwgname")) 4)
             )
    )
    (setq op (open (strcat (getvar "dwgprefix") fl "_exppl.txt") "w"))
    (progn
      ((lambda (i / sn p d)
         (while (setq sn (ssname ss (setq i (1+ i))))
           (mapcar
             '(lambda (x)
                (and (= (car x) 10)
                     (or (and p (setq d (distance p (setq p (cdr x)))))
                         (setq p (cdr x))
                     )
                     (write-line
                       (strcat (itoa nr)
                               ","
                               (rtos (cadr p) 2 3)
                               ","
                               (rtos (car p) 2 3)
                               (if d
                                 (strcat "," (rtos d 2 3))
                                 ""
                               )
                       )
                       op
                     )
                     (setq nr (1+ nr))
                )
              )
             (entget sn)
           )
           (foreach itm (list (list "Perimeter = "
                                    (vlax-curve-getdistatparam
                                      sn
                                      (vlax-curve-getendparam sn)
                                    )
                              )
                              (list "Area = " (vlax-curve-getarea sn))
                        )
             (write-line (strcat (car itm) (rtos (cadr itm) 2 3)) op)
           )
         )
       )
        -1
      )
      (close op)
    )
  )
  (princ)
)

Almost

The only issue is that the output looks like this:

50,379.803,241.522
51,379.803,444.244,202.722
52,237.184,444.244,142.618
53,237.184,241.522,202.722
Perimeter = 690.681
Area = 28911.901

The distance on line 2 should be on line 1. The one on line 3 should be on line 2 and so on. Then, the distance on last line should be the distance between last point and first point. In present output a distance is missing. I attach the test DWG from which I got the above output.

So it should look like this:

50,379.803,241.522,202.722
51,379.803,444.244,142.618
52,237.184,444.244,202.722
53,237.184,241.522,142.618
Perimeter = 690.681
Area = 28911.901

Thank you so much for your help, @Tharwat!

1.dwg

Edited March 27, 2023 by Radu Iordache

March 27, 2023

6 minutes ago, Radu Iordache said:

Almost

The only issue is that the output looks like this:

50,379.803,241.522
51,379.803,444.244,202.722
52,237.184,444.244,142.618
53,237.184,241.522,202.722
Perimeter = 690.681
Area = 28911.901

The distance on line 2 should be on line 1. The one on line 3 should be on line 2 and so on. Then, the distance on last line should be the distance between last point and first point. In present output a distance is missing. I attach the test DWG from which I got the above output.

So it should look like this:

50,379.803,241.522,202.722
51,379.803,444.244,142.618
52,237.184,444.244,202.722
53,237.184,241.522,142.618
Perimeter = 690.681
Area = 28911.901

Thank you so much for your help, @Tharwat!

1.dwg 63.89 kB · 0 downloads

Have you tried my post...

It should allow multiple polylines selection... Only lack is that it's not applicable for arced segmented polylines...

Tschus...

M.R.

March 27, 2023

1 hour ago, marko_ribar said:

According to posted *.lsp...

(defun c:exppl ( / ss n fl op )
  ;; Tharwat. 11.May.16	;;
  ;; Modified           ;;

  (vl-load-com)

  (if (= 0 (getvar (quote dwgtitled)))
    (alert "Please, save DWG and restart routine... Quitting...")
    (progn
      (initget 6)
      (setq n (cond ( (getint "\nNumber of first point <1> : ") ) (1)))
      (princ "\nSelect polylines : ")
      (and
        (setq ss (ssget (list (cons 0 "LWPOLYLINE,POLYLINE") (cons -4 "&") (cons 70 1))))
        (setq fl (substr (getvar (quote dwgname)) 1 (- (strlen (getvar (quote dwgname))) 4)))
        (setq op (open (strcat (getvar (quote dwgprefix)) fl "_exppl.txt") "w"))
        (progn
          ( (lambda ( i / nr sn p as pp )
              (while (setq sn (ssname ss (setq i (1+ i))))
                (setq nr n)
                (mapcar 
                  (function (lambda ( x )
                    (and
                      (= (car x) 10)
                      (setq p (cdr x))
                      (if (setq as (assoc 10 (cdr (member x (entget sn)))))
                        (setq pp (cdr as))
                        (setq pp (cdr (assoc 10 (entget sn))))
                      )
                      (write-line (strcat (itoa nr) "," (rtos (cadr p) 2 3) "," (rtos (car p) 2 3) "," (rtos (distance p pp) 2 3)) op)
                      (setq nr (1+ nr))
                    )
                  ))
                  (entget sn)
                )
                (write-line (strcat "Area = " (rtos (vlax-curve-getarea sn) 2 3)) op)
                (write-line (strcat "Perimeter = " (rtos (vlax-curve-getdistatparam sn (vlax-curve-getendparam sn)) 2 3)) op)
                (write-line "" op)
              )
            )
            -1
          )
          (close op)
        )
      )
    )
  )
  (princ)
)

Untested, though...

HTH.

M.R.

Yes, it works great!! First I tested in Autocad and it returned an error like "unable to get ObjectID. Now I tested in ProgeCAD and it's doing exactly what I wanted. Thank you so much @marko_ribar!

And the Alert about saving the DWG is priceless!

Edited March 27, 2023 by Radu Iordache

March 27, 2023

38 minutes ago, marko_ribar said:

Have you tried my post...

It should allow multiple polylines selection... Only lack is that it's not applicable for arced segmented polylines...

Tschus...

M.R.

@marko_ribar, after my reply above I tested some more and I found one issue. If I have more than 1 polyline, it starts numbering for each one with the same number. For example, if I input 50 as start number and I have 2 polylines, the output looks like this:

50,364.522,60.192,124.28
51,364.522,184.474,156.88
52,207.642,184.474,124.28
53,207.642,60.192,156.88
Area = 19497
Perimeter = 562.32

50,379.803,241.522,202.72
51,379.803,444.244,142.62
52,237.184,444.244,202.72
53,237.184,241.522,142.62
Area = 28912
Perimeter = 690.68

It should continue the numbering, second polyline being 54,55,56,57. Can it be solved? Thanks again so much!

Edited March 27, 2023 by Radu Iordache

March 27, 2023

@Radu Iordache ~~Take out this line to fix the numbering.~~ Ooops .. move it above the while loop

Edited March 28, 2023 by ronjonp

March 27, 2023

Here you go, the idea behind coding the program this way seems insane and different.

(defun c:exppl (/ ss fl op nr e a l)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (initget 6)
  (or (setq nr (getint "\nNumber of first point <1> : "))
      (setq nr 1)
  )
  (princ "\nSelect polylines :")
  (and
    (setq ss (ssget ":S" '((0 . "LWPOLYLINE,POLYLINE"))))
    (setq fl (substr (getvar "dwgname")
                     1
                     (- (strlen (getvar "dwgname")) 4)
             )
    )
    (setq op (open (strcat (getvar "dwgprefix") fl "_exppl.txt") "w"))
    (progn
      ((lambda (i / g m p d)
         (while (setq e (ssname ss (setq i (1+ i))))
           (setq g (entget e)
                 a (assoc 10 g)
                 m (cdr (cddddr (member a g)))
                 g (append g (list a))
                 a (cdr a)
                 l nil
           )
           (or l (setq l a))
           (mapcar
             '(lambda (x)
                (and (= (car x) 10)
                     (setq p (cdr x))
                     (write-line
                       (strcat (itoa nr) "," (rtos (cadr a) 2 3) "," (rtos (car a) 2 3) "," (rtos (distance a p) 2 3))
                       op
                     )
                     (setq nr (1+ nr)
                           a  p
                     )
                )
              )
             m
           )
           (write-line
             (strcat (itoa nr) "," (rtos (cadr a) 2 3) "," (rtos (car a) 2 3) "," (rtos (distance a l) 2 3)) op
           )
           (setq nr (1+ nr))
           (foreach itm (list (list "Perimeter = "
                                    (vlax-curve-getdistatparam
                                      e
                                      (vlax-curve-getendparam e)
                                    )
                              )
                              (list "Area = " (vlax-curve-getarea e))
                        )
             (write-line (strcat (car itm) (rtos (cadr itm) 2 3)) op)
           )
         )
       )
        -1
      )
      (close op)
    )
  )
  (princ)
) (vl-load-com)

Edited March 28, 2023 by Tharwat

March 28, 2023

9 hours ago, ronjonp said:

@Radu Iordache Take out this line to fix the numbering

Does not work for me, it gives a bad argument type error if I remove it.

March 28, 2023

7 hours ago, Tharwat said:

Here you go, the idea behind coding the program this way seems insane and different.

(defun c:exppl (/ ss fl op nr e a l)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (initget 6)
  (or (setq nr (getint "\nNumber of first point <1> : "))
      (setq nr 1)
  )
  (princ "\nSelect polylines :")
  (and
    (setq ss (ssget ":S" '((0 . "LWPOLYLINE,POLYLINE"))))
    (setq fl (substr (getvar "dwgname")
                     1
                     (- (strlen (getvar "dwgname")) 4)
             )
    )
    (setq op (open (strcat (getvar "dwgprefix") fl "_exppl.txt") "w"))
    (progn
      ((lambda (i / g m p d)
         (while (setq e (ssname ss (setq i (1+ i))))
           (setq g (entget e)
                 a (assoc 10 g)
                 m (cdr (cddddr (member a g)))
                 g (append g (list a))
                 a (cdr a)
           )
           (or l (setq l a))
           (mapcar
             '(lambda (x)
                (and (= (car x) 10)
                     (setq p (cdr x))
                     (write-line
                       (strcat (itoa nr) "," (rtos (cadr a) 2 3) "," (rtos (car a) 2 3) "," (rtos (distance a p) 2 3))
                       op
                     )
                     (setq nr (1+ nr)
                           a  p
                     )
                )
              )
             m
           )
           (write-line
             (strcat (itoa nr) "," (rtos (cadr a) 2 3) "," (rtos (car a) 2 3) "," (rtos (distance a l) 2 3)) op
           )
           (setq nr (1+ nr))
           (foreach itm (list (list "Perimeter = "
                                    (vlax-curve-getdistatparam
                                      e
                                      (vlax-curve-getendparam e)
                                    )
                              )
                              (list "Area = " (vlax-curve-getarea e))
                        )
             (write-line (strcat (car itm) (rtos (cadr itm) 2 3)) op)
           )
         )
       )
        -1
      )
      (close op)
    )
  )
  (princ)
) (vl-load-com)

@Tharwat Later edit: something wrong happens with the distances starting with the second polyline. For example, these are 3 rectangles. I marked in red the wrong distances.

50,379.803,241.522,202.72
51,379.803,444.244,142.62
52,237.184,444.244,202.72
53,237.184,241.522,142.62

Perimeter = 690.681

Area = 28911.901

54,419.282,491.983,116.88
55,419.282,608.862,133.15
56,286.127,608.862,116.88
57,286.127,491.983,267.41

Perimeter = 500.068

Area = 15563.048

58,204.097,267.437,431.93
59,204.097,699.368,37.49
60,166.609,699.368,431.93
61,166.609,267.437,214.76

Perimeter = 938.837

Area = 16192.325

Initial reply:

Thanks a lot, it works great!

Edited March 28, 2023 by Radu Iordache

March 28, 2023

2 hours ago, Radu Iordache said:

Initial reply:

Thanks a lot, it works great!

You're welcome.

March 28, 2023

I didn't know you needed continuation of vertices between polylines... I've mod. my version, you can test it - should work...

Edited March 28, 2023 by marko_ribar

March 28, 2023

@Radu Iordache There was one minor issue if you select more than one polylne then the outcome would mix up with the other polylines' data so I have revised the codes above accordingly.

March 28, 2023

@Tharwat Can you tell me what's wrong with my interpretation?

March 28, 2023

I am talking about my codes and not yours.

March 29, 2023

Thanks @marko_ribar and @Tharwat, both updated versions are great!

Sign In

Lisp modification - export polyline vertices (original by Tharwat)

Recommended Posts

Radu Iordache

marko_ribar

Tharwat

Radu Iordache

marko_ribar

Radu Iordache

Radu Iordache

ronjonp

Tharwat

Radu Iordache

Radu Iordache

Tharwat

marko_ribar

Tharwat

marko_ribar

Tharwat

Radu Iordache

Join the conversation

Tutorials

Forums

Activity