Author Topic: HELP WITH A LISP (Read 8852 times)

pedroantonio · « **on:** January 17, 2017, 11:39:06 AM »

Hi , i use this code to export attribiute points from my drawings. I select with window all the points and export them to a file P,X,Y,Z or P,X,Y or P,X,Y,D

The only problem is that all points are radom in the file not in the correct possition. For example we hane 10,5,2,3,9,T1,S3,1 etc .The correct possition is 1,2,3,5,9,S3,T1. I know i can do this with MS Excell or with a notepad , but i need something faster. I don't know if it possoble to be done with lisp.

The code is

Code - Auto/Visual Lisp: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                             ;;
;;                                      PXYZD                                  ;; 
;;                                                                             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(defun c:PXYZD ( / *error* del des ent idx lst obj ord out sel )
 
    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (setq ord '("POINT" POINT-X POINT-Y "ELEV" "DESC")
          out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
          del  ","
    )
    (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
        (if (setq des (open out "w"))
            (progn
                (repeat (setq idx (sslength sel))
                    (setq ent (ssname sel (setq idx (1- idx)))
                          obj (vlax-ename->vla-object ent)
                    )
                    (setq lst
                        (append
                            (mapcar '(lambda ( a b ) (cons a (rtos b)))
                               '(point-x point-y point-z)
                                (trans (cdr (assoc 10 (entget ent))) ent 0)
                            )
                            (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
                                (append
                                    (vlax-invoke obj 'getattributes)
                                    (vlax-invoke obj 'getconstantattributes)
                                )
                            )
                        )
                    )
                    (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
                        (write-line (LM:lst->str lst del) des)
                    )
                )
                (setq des (close des))
            )
            (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
        )
    )
    (princ)
)                
 
;; List to String  -  Lee Mac
;; Concatenates each string in a list, separated by a given delimiter
 
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
 
;; Unique Filename  -  Lee Mac
;; Returns a unique filename for a given path & file extension
 
(defun LM:uniquefilename ( pth ext / fnm tmp )
    (if (findfile (setq fnm (strcat pth ext)))
        (progn
            (setq tmp 1)
            (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
        )
    )
    fnm
)
 
(vl-load-com) (princ)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                             ;;
;;                                      PXYZ                                   ;; 
;;                                                                             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(defun c:PXYZ ( / *error* del des ent idx lst obj ord out sel )
 
    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
          out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
          del  ","
    )
    (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
        (if (setq des (open out "w"))
            (progn
                (repeat (setq idx (sslength sel))
                    (setq ent (ssname sel (setq idx (1- idx)))
                          obj (vlax-ename->vla-object ent)
                    )
                    (setq lst
                        (append
                            (mapcar '(lambda ( a b ) (cons a (rtos b)))
                               '(point-x point-y point-z)
                                (trans (cdr (assoc 10 (entget ent))) ent 0)
                            )
                            (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
                                (append
                                    (vlax-invoke obj 'getattributes)
                                    (vlax-invoke obj 'getconstantattributes)
                                )
                            )
                        )
                    )
                    (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
                        (write-line (LM:lst->str lst del) des)
                    )
                )
                (setq des (close des))
            )
            (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
        )
    )
    (princ)
)                
 
;; List to String  -  Lee Mac
;; Concatenates each string in a list, separated by a given delimiter
 
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
 
;; Unique Filename  -  Lee Mac
;; Returns a unique filename for a given path & file extension
 
(defun LM:uniquefilename ( pth ext / fnm tmp )
    (if (findfile (setq fnm (strcat pth ext)))
        (progn
            (setq tmp 1)
            (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
        )
    )
    fnm
)
 
(vl-load-com) (princ)
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                             ;;
;;                                      PXY                                    ;; 
;;                                                                             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(defun c:PXY ( / *error* del des ent idx lst obj ord out sel )
 
    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (setq ord '("POINT" POINT-X POINT-Y )
          out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
          del  ","
    )
    (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
        (if (setq des (open out "w"))
            (progn
                (repeat (setq idx (sslength sel))
                    (setq ent (ssname sel (setq idx (1- idx)))
                          obj (vlax-ename->vla-object ent)
                    )
                    (setq lst
                        (append
                            (mapcar '(lambda ( a b ) (cons a (rtos b)))
                               '(point-x point-y point-z)
                                (trans (cdr (assoc 10 (entget ent))) ent 0)
                            )
                            (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
                                (append
                                    (vlax-invoke obj 'getattributes)
                                    (vlax-invoke obj 'getconstantattributes)
                                )
                            )
                        )
                    )
                    (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
                        (write-line (LM:lst->str lst del) des)
                    )
                )
                (setq des (close des))
            )
            (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
        )
    )
    (princ)
)                
 
;; List to String  -  Lee Mac
;; Concatenates each string in a list, separated by a given delimiter
 
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
 
;; Unique Filename  -  Lee Mac
;; Returns a unique filename for a given path & file extension
 
(defun LM:uniquefilename ( pth ext / fnm tmp )
    (if (findfile (setq fnm (strcat pth ext)))
        (progn
            (setq tmp 1)
            (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
        )
    )
    fnm
)
 
(vl-load-com) (princ)
[code]
 

Lee Mac · « **Reply #1 on:** January 17, 2017, 12:18:46 PM »

Source & attribution.

CAB · « **Reply #2 on:** January 17, 2017, 12:29:26 PM »

Thanks Lee for the heads up.

pedroantonio · « **Reply #3 on:** January 17, 2017, 02:48:00 PM »

Any ideas ?

JohnK · « **Reply #4 on:** January 17, 2017, 03:47:13 PM »

HELP WITH THE SUBJECT LINE!
Please tell me how the subject of this thread and the question relate. Please tell me how this subject line will help another user find this thread if they have a similar problem.

Re: HELP WITH A LISP
I don't think I understand fully what the output is you are trying to sort looks like but you can use simple Unix tools to do this and a thousand other different combinations of what you may want/need (There are a lot of tools created for just operating on delimited text files). -e.g. AWK and SORT for example.

https://www.theswamp.org/index.php?topic=8476.msg492563#msg492563
http://www.linuxquestions.org/questions/linux-general-1/how-to-use-awk-to-sort-243177/
http://www.linuxfocus.org/English/September1999/article103.html

ChrisCarlson · « **Reply #5 on:** January 17, 2017, 03:50:39 PM »

You simply need to sort the data, before passing it to "LM:lst->str". Although you probably won't get much help in this topic. Changing the command is one thing but completely deleting the attribution, not cool.

pedroantonio · « **Reply #6 on:** January 17, 2017, 05:42:10 PM »

for example the export coordinates are

Code: [Select]

3,293649.870,4225552.726,
5,293657.899,4225547.326,
7,293650.257,4225543.748,
6,293653.935,4225545.454,
8,293647.561,4225542.282,
2,293639.053,4225547.491,
9,293644.538,4225540.620,
1,293642.102,4225539.320,
s2,293635.766,4225553.648,
s1,293637.563,4225539.929,
s3,293655.810,4225554.488,
s4,293662.935,4225556.538,
4,293654.540,4225554.975,

The numbers are random. Is any command or function to put them in the correct possition ??

kdub_nz · « **Reply #7 on:** January 17, 2017, 06:43:17 PM »

Perhaps try something like

Code - Auto/Visual Lisp: [Select]

(vl-sort lst '<)

or Google
AutoLisp sort list of strings
https://www.google.com.au/webhp?source=search_app&gfe_rd=cr&ei=WFtzVuOUI-zN8AefzYCIAg&gws_rd=ssl#q=AutoLisp+sort+list+of+strings

mailmaverick · « **Reply #8 on:** January 17, 2017, 11:25:44 PM »

Sorting is not a difficult task, kindly attach your AutoCAD file.

pedroantonio · « **Reply #9 on:** January 18, 2017, 05:02:36 AM »

I dont know how to use this command

Code - Auto/Visual Lisp: [Select]

(vl-sort lst '<)
 

CAB · « **Reply #10 on:** January 18, 2017, 08:22:15 AM »

Then look it up in the help files.

JohnK · « **Reply #11 on:** January 18, 2017, 08:29:16 AM »

Quote from: CAB on January 18, 2017, 08:22:15 AM

Then look it up in the help files.

Or make use my hard work and click the function name in the code block?

Marc'Antonio Alessi · « **Reply #12 on:** January 18, 2017, 09:01:09 AM »

Quote from: CAB on January 18, 2017, 08:22:15 AM

Then look it up in the help files.

... and make your apology for Source & attribution: http://bit.ly/11XjtTZ

ronjonp · « **Reply #13 on:** January 18, 2017, 09:42:59 AM »

Quote from: Topographer on January 18, 2017, 05:02:36 AM

I dont know how to use this command

Code - Auto/Visual Lisp: [Select]
(vl-sort lst '<)

There are hyperlinks in the post that give an explanation ... does not get much easier than that to TRY and figure it out.

JohnK · « **Reply #14 on:** January 18, 2017, 10:05:16 AM »

Thank you, ronjonp!

News:

Author Topic: HELP WITH A LISP (Read 8852 times)

pedroantonio

pedroantonio

ChrisCarlson

pedroantonio

pedroantonio