Jump to content

Lisp modification - export polyline vertices (original by Tharwat)


Radu Iordache

Recommended Posts

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 by Radu Iordache
  • Thanks 1
Link to comment
Share on other sites

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

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

 

  • Like 1
Link to comment
Share on other sites

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

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.

  • Thanks 1
Link to comment
Share on other sites

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

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

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

(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 by Tharwat
  • Like 1
Link to comment
Share on other sites

7 hours ago, Tharwat said:

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

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

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

Edited by marko_ribar
  • Like 1
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...