Code Red > AutoLISP (Vanilla / Visual)

HELP WITH A LISP

(1/9) > >>

pedroantonio:
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: ---;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                                                                             ;;;;                                      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:
Source & attribution.

CAB:
Thanks Lee for the heads up.

pedroantonio:
Any ideas ?

JohnK:
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

Navigation

[0] Message Index

[#] Next page