Lisp modification - export polyline vertices (original by Tharwat)

[Radu Iordache]

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

[marko_ribar]

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

[Tharwat]

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

 

[Radu Iordache]

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

[marko_ribar]

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.

[Radu Iordache]

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

[Radu Iordache]

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

[ronjonp]

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

Edited March 28, 2023 by ronjonp

[Tharwat]

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

[Radu Iordache]

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.

[Radu Iordache]

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

[Tharwat]

2 hours ago, Radu Iordache said:

Initial reply:

Thanks a lot, it works great!

You're welcome.

[marko_ribar]

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

[Tharwat]

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

[marko_ribar]

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

[Tharwat]

I am talking about my codes and not yours.

[Radu Iordache]

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