Simple Lisp Modification

April 6, 2023

I have the following Lisp, it returns coordinates of poly lines and their lengths. The lisp is printing the coordinate's of each polyline's node, I would like this to return Just the length of each poly line. If anyone could also help me add an additional column that counts the number of polylines in 10's. (first polyline would be 10, second poly line 20, third poly line 30, and so on) Thanks you so much!! Ive included a picture of the output im currently getting with the doubled up values.

(defun c:A22 ( / *error* ss f fName cnt e eg en typ han lyr len txt tmp pnt)
;Lines 2 Csv
    ;error handle
    (defun *error* ( msg )
        (if f (close f))
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        );if
        (princ)
    );defun error
;ensure items selected
(if (not (setq ss (ssget '((0 . "*LINE")))))
  (progn (prompt "\n...invalid.") (exit))
);if
;be sure file does not exist
(setq fName (getvar 'DWGNAME))
(setq fName (strcat (getvar 'DWGPREFIX) (substr fName 1 (- (strlen fName) 4)) ".csv"))
(if (findfile fName)
  (progn (prompt "...file already exists.") (exit))
);if
;prep file/vars
(vl-load-com)
(setq f (open fName "w"))
(write-line "HANDLE,LENGTH,LAYER,X,Y,Z" F)
;loop through ss
(repeat (setq cnt (sslength ss))
  ;gather basic info
  (setq e (ssname ss (setq cnt (1- cnt))))
  (setq eg (entget e) typ (cdr (assoc 0 eg)))
  (setq han (cdr (assoc 5 eg)) lyr (cdr (assoc 8 eg)))
  (setq len (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
  (setq txt (strcat han "," len "," lyr ","))
  ;get type-specific info (vertices)
  (cond
    ((eq "LWPOLYLINE" typ)
      (while (setq eg (member (assoc 10 eg) eg))
    (setq pnt (cdr (car eg)) eg (cdr eg))
    (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) ",0.0"))
    (write-line tmp f)
      );while
    );cond LWPOLYLINE
    ((eq "POLYLINE" typ)
      (setq en (entnext e))
      (while (/= "SEQEND" (cdr (assoc 0 (setq eg (entget en)))))
    (while (setq eg (member (assoc 10 eg) eg))
      (setq pnt (cdr (car eg)) eg (cdr eg))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
    );while
    (setq en (entnext en))
      );while
    );cond POLYLINE
    ((eq "LINE" typ)
      (setq pnt (cdr (assoc 10 eg)))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
      (setq pnt (cdr (assoc 11 eg)))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
    );cond LINE
    ((eq "SPLINE" typ)
      (while (setq eg (member (assoc 11 eg) eg))
    (setq pnt (cdr (car eg)) eg (cdr eg))
    (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
    (write-line tmp f)
      );while
    );cond SPLINE
    (t (prompt "\n...invalid item selected. Ignored."))
  );cond
);repeat
;finish up / inform user
(close f)
(prompt "\nL2C Complete...")
(princ)
);defun

Edited April 11, 2023 by SLW210
Code Tags!!

April 8, 2023

@MF1 please upload sample.dwg version 2019

April 8, 2023

In this LISP you are creating a CSV file, comma separated data, which as far as LISP is concerned is just a text file - and knowing this helps you along the way/

To modify or create a text file the LISP uses the command "write-line" to well, write each line of the text / CSV file

For example, your header row is created using this:

(write-line "HANDLE,LENGTH,LAYER,X,Y,Z" F)

You could modify that line to be:

(write-line "HANDLE,LENGTH" F)

So look through the rest of the code for all the "write-lines"

These all have the format: (copying the line before as well)

    (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) ",0.0"))
    (write-line tmp f)

"write-line tmp f" writes the variable tmp to the text file. Looking at tmp, strcat is like excel concatenate, joins text strings together, so tmp is the variable txt, and some stuff done to variable pnt - which I guess is 'point'

So go back up the code a bit, txt is defined once:

(setq txt (strcat han "," len "," lyr ","))

So what to do.....

Modify the header row as above. "Handle,Length"

and just before the (write-line tmp f) line just put (setq tmp txt), noting I also comment out (add ;;) the original setq tmp line - just so you can go back to the original if needed

;;    (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) ",0.0"))
    (setq tmp txt)
    (write-line tmp f)

Right now adding in the count.

You'll want to set a counter somewhere in this. the code has a 'repeat' command, perhaps before then put in a line such as

(setq acount 0)

Then the first line after repeat increment this as you want

(setq acount (+ acount 10))

then work out how to modify the header to show the acount (look earlier in this answer), and also how to add this to the correct part of the variable tmp (perhaps looking at the strcat line above for a hint)

see how that works and ask again if you need more info.... long weekend break here so no CAD nut I can give you hints rather than a finished LISP

April 8, 2023

There are lisps for count items in a list so you can count all the 10.123 length lines the 12.345 lines and so on ending up with a quantities list that you can send to excel.

("6BA" 10.3637 "BORDER" 12.34 15.67 2) where 2 is number of matching items.

Bit short for time right now if no one posts will post something later.

April 10, 2023

Hi Steve, Thank you for the help thus far. I have one last request. I used your code and was able to get the Handle, and Length to display on my excel file.

I would like just one last column displayed in the excel file and that is the X coordinate associated with the polylines (all of the polylines are vertical so the X doesn't change between the nodes in each polyline). Also, it seems the code is still outputting two of the same lengths for each polyline. Here is what I have currently which is just what I copied from you

(defun c:PLLi ( / *error* ss f fName cnt e eg en typ han lyr len txt tmp pnt)
;Lines 2 Csv
    ;error handle
    (defun *error* ( msg )
        (if f (close f))
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        );if
        (princ)
    );defun error
;ensure items selected
(if (not (setq ss (ssget '((0 . "*LINE")))))
  (progn (prompt "\n...invalid.") (exit))
);if
;be sure file does not exist
(setq fName (getvar 'DWGNAME))
(setq fName (strcat (getvar 'DWGPREFIX) (substr fName 1 (- (strlen fName) 4)) ".csv"))
(if (findfile fName)
  (progn (prompt "...file already exists.") (exit))
);if
;prep file/vars
(vl-load-com)
(setq f (open fName "w"))
(write-line "HANDLE,LENGTH,X" F)
;loop through ss
(repeat (setq cnt (sslength ss))
  ;gather basic info
  (setq e (ssname ss (setq cnt (1- cnt))))
  (setq eg (entget e) typ (cdr (assoc 0 eg)))
  (setq han (cdr (assoc 5 eg)) lyr (cdr (assoc 8 eg)))
  (setq len (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
  ;; (setq txt (strcat han "," len "," lyr ","))
(setq txt (strcat han "," len ","))
  ;get type-specific info (vertices)
  (cond
    ((eq "LWPOLYLINE" typ)
      (while (setq eg (member (assoc 10 eg) eg))
    (setq pnt (cdr (car eg)) eg (cdr eg))
;; (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) ",0.0"))
    (setq tmp txt)
    (setq acount 0)
    (setq acount (+ acount 10))
    (write-line tmp f)
      );while
    );cond LWPOLYLINE
    ((eq "POLYLINE" typ)
      (setq en (entnext e))
      (while (/= "SEQEND" (cdr (assoc 0 (setq eg (entget en)))))
    (while (setq eg (member (assoc 10 eg) eg))
      (setq pnt (cdr (car eg)) eg (cdr eg))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
    );while
    (setq en (entnext en))
      );while
    );cond POLYLINE
    ((eq "LINE" typ)
      (setq pnt (cdr (assoc 10 eg)))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
      (setq pnt (cdr (assoc 11 eg)))
      (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
      (write-line tmp f)
    );cond LINE
    ((eq "SPLINE" typ)
      (while (setq eg (member (assoc 11 eg) eg))
    (setq pnt (cdr (car eg)) eg (cdr eg))
    (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
    (write-line tmp f)
      );while
    );cond SPLINE
    (t (prompt "\n...invalid item selected. Ignored."))
  );cond
);repeat
;finish up / inform user
(close f)
(prompt "\nL2C Complete...")
(princ)
);defun

Edited April 11, 2023 by SLW210
Code Tags!!

April 10, 2023

We still don't see where you use "acount" variable... And if you need consecutive additions, move (setq acount 0) before complete (repeat loop...

April 11, 2023

EDIT - Had another thought

Try this, I've put the code in 'code tags', press the '<>' button and paste code in the pop up to do that.

In this version I have added in the count - you had the code in there but just not quite the right place, and added the count into the data line (see my comments what I added / took away and where)

For the duplicated line lengths, the code was putting in a line for the last point in a line / polyline / spline, so I have taken that out to give just the start 'X' coordinate

Final things, test this and try it out, then you can perhaps delete all the lines that are commented out (those that start with ;;, lines starting with a single ; I'd leave in though ) and also have a read through and ask if you want to find out what it all does.

(defun c:PLLi ( / *error* ss f fName cnt e eg en typ han lyr len txt tmp pnt acount)
;Lines 2 Csv
;error handle function
  (defun *error* ( msg )
    (if f (close f)) ; close any file opened
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg)) ; show error message
    );if
    (princ)
  );defun error
;End error function

;ensure items selected
  (if (not (setq ss (ssget '((0 . "*LINE")))))
    (progn (prompt "\n...invalid.") (exit))
  );if

;be sure file does not exist
  (setq fName (getvar 'DWGNAME))
  (setq fName (strcat (getvar 'DWGPREFIX) (substr fName 1 (- (strlen fName) 4)) ".csv"))
  (if (findfile fName)
    (progn (prompt "...file already exists.") (exit))
  );if

;prep file/vars
  (vl-load-com)
  (setq f (open fName "w"))

;;  (write-line "HANDLE,LENGTH,X" F)
  (write-line "COUNT,HANDLE,LENGTH,X" F) ; Modified this line for the column headers

;loop through ss

  (setq acount 0) ;create a counter ; Added this here instead of below

  (repeat (setq cnt (sslength ss))

    (setq acount (+ acount 10)) ;; increase count ; added this here instead of below

;gather basic info
    (setq e (ssname ss (setq cnt (1- cnt))))
    (setq eg (entget e) typ (cdr (assoc 0 eg)))
    (setq han (cdr (assoc 5 eg)) lyr (cdr (assoc 8 eg)))
    (setq len (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
;;    (setq txt (strcat han "," len "," lyr ","))
;;    (setq txt (strcat han "," len ","))

    (setq txt (strcat (rtos acount) "," han "," len ",")) ; modified adding 'acount' counter. RTOS makes count a string

;get type-specific info (vertices)
    (cond
      ((eq "LWPOLYLINE" typ)
        (while (setq eg (member (assoc 10 eg) eg))
          (setq pnt (cdr (car eg)) eg (cdr eg))

;ignore last coordinate ; added this
          (if (= (member (assoc 10 eg) eg) nil) ; added this
            () ; added this
            (progn ; added this

;;              (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) ",0.0"))
;;              (setq tmp txt) ; removed this line now you are using point X (see line above)
;;              (setq acount 0) ; this should be earlier in the code - see above - can delete this line
;;              (setq acount (+ acount 10)) ; this should be earilier in the code - see above - can delete this line

              (setq tmp (strcat txt (rtos (car pnt) 2) "," )) ;; Modified this line to give just 'X' - at end of repeat
              (write-line tmp f) ; copied this line to the end of the repeat

            ) ; end progn ; Added this
          ) ; end if ; Added this

        );while
      );cond LWPOLYLINE
      ((eq "POLYLINE" typ)
        (setq en (entnext e))
        (while (/= "SEQEND" (cdr (assoc 0 (setq eg (entget en)))))
          (while (setq eg (member (assoc 10 eg) eg))
            (setq pnt (cdr (car eg)) eg (cdr eg))

;ignore last coordinate ; added this
            (if (= (member (assoc 10 eg) eg) nil) ; added this
              () ; added this
              (progn ; added this

;;                (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
                (setq tmp (strcat txt (rtos (car pnt) 2) "," )) ;; Modified this line to give just 'X' - at end of repeat
                (write-line tmp f) ; at end of repeat

              ) ; end progn ; Added this
            ) ; end if ; Added this

          );while
          (setq en (entnext en))
        );while
      );cond POLYLINE
      ((eq "LINE" typ)
        (setq pnt (cdr (assoc 10 eg)))
;;        (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
        (setq tmp (strcat txt (rtos (car pnt) 2) "," )) ;; Modified this line to give just 'X'
        (write-line tmp f)
;;        (setq pnt (cdr (assoc 11 eg))) ; makes entry for the end point
;;        (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
;;        (setq tmp (strcat txt (rtos (car pnt) 2) "," )) ;; Modified this line to give just 'X' - at end of repeart
;;        (write-line tmp f) ; at end of repeat

      );cond LINE
      ((eq "SPLINE" typ)
        (while (setq eg (member (assoc 11 eg) eg))
          (setq pnt (cdr (car eg)) eg (cdr eg))

;ignore last coordinate ; added this
          (if (= (member (assoc 10 eg) eg) nil) ; added this
            () ; added this
            (progn ; added this

;;            (setq tmp (strcat txt (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2)))
              (setq tmp (strcat txt (rtos (car pnt) 2) "," )) ;; Modified this line to give just 'X' - ant end of repeat
              (write-line tmp f) ; at end of repeat

            ) ; end progn ; Added this
          ) ; end if ; Added this

        );while
      );cond SPLINE
      (t (prompt "\n...invalid item selected. Ignored."))
    );End conds

  );repeat
;finish up / inform user
  (close f)
;;  (prompt "\nL2C Complete...")

  (prompt "\nPLLI Complete...") ;; The name of this LISP?

  (princ)
);defun

Edited April 11, 2023 by Steven P

April 11, 2023

Please Use Code Tags!!

April 12, 2023

When posting code @MF1

Edited April 12, 2023 by mhupp

April 28, 2023

Thanks for all the help Steven, and others. The lisp is now working perfectly!

Sign In

Simple Lisp Modification

Recommended Posts

MF1

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

MF1

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

SLW210

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

MF1

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity