Jump to content

Text Export to csv/txt sort by coordinate

edmondsforum

By edmondsforum
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

edmondsforum Rookie

edmondsforum

Posted
Posted (edited)

Dear All,

Is there any way to let Text export to csv/txt sort by coordinate , i hope it can sort  From left to the right, from top to the bottom

 

example A .jpg the Text export to example B.jpg

 

A .jpg

A.jpg

 

 

B.jpg

B.jpg

 

 

Edited by edmondsforum
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
Posted (edited) 
(defun c:ttx2 (/ ss xlApp xlCells row col i)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
(vla-put-visible xlApp :vlax-true)
(foreach y
(mapcar '(lambda (x / iPt)
(setq iPt (vlax-get x 'InsertionPoint))
(list (LM:UnFormat (vla-get-TextString x) nil)
(rtos (car iPt) 2 2)
(rtos (cadr iPt) 2 2)
(rtos (caddr iPt) 2 2)))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(if (> row 65536) (setq col 5))
(setq i -1 row (1+ row))
(mapcar
(function
(lambda (x)
(vlax-put-property xlCells "Item" row
(+ col (setq i (1+ i))) x))) y))))
(mapcar 'vlax-release-object (list xlApp xlCells))
(princ))




;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

This routine can export text and x, y, z coordinates to excel

I get this at

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autocad-how-get-text-to-excel-use-visual-lisp/td-p/9539871

 

then I add LM:unformat for mtexts.

http://www.lee-mac.com/unformatstring.html

 

then add first row for filter,

then sort ascending C column (y axis, up to down) first, B column (x axis, left to right) second in excel.

https://support.microsoft.com/en-us/office/sort-data-in-a-table-77b781bf-5074-41b0-897a-dc37d4515f27

 

Edited by exceed
  • Like 1
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
Posted (edited) 
(vl-load-com)
(defun c:TEXTEXPORT( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat)

    ;    Sub-function - 01
    (defun PTE:sortobj

        (   olst typ tol /
            typ objs opt npt lst data lst rev sx sy dxf x y
            PTE:s1 PTE:s2 PTE:s3 PTE:s4
        )
        
        (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
        (defun sx  (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
        (defun sy  (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
        (defun dxf (o c)  (cdr  (assoc c (entget (vlax-vla-object->ename o)))))
        (defun x   (o)    (car  (dxf o 10)))
        (defun y   (o)    (cadr (dxf o 10)))
        
        (setq typ (vl-string->list (strcase typ)))
        
        (if (member (car typ) '(76 82))
            (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
            (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
        )
        
        (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
        
        (foreach o objs
            (if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
                (setq lst  (cons data lst) data (list o) opt npt)
                (setq data (cons o data))
            )
        )
        
        (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
              lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
              lst (if (member (car typ)  '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
              lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
        )
    )
    
    ;    Sub-function - 02
    (defun LM:UnFormat ( str mtx / _Replace regex )
        ;; ⓒ Lee Mac 2010
        (defun _Replace ( new old str )
            (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new)
        )
        (setq regex (vlax-get-or-create-object "VBScript.RegExp"))  
        (mapcar
            (function
                (lambda ( x ) (vlax-put-property regex (car x) (cdr x)))
            )
            (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
        )
        (mapcar
            (function
                (lambda ( x ) (setq str (_Replace (car x) (cdr x) str)))
            )
            '(
                ("Ð"       . "\\\\\\\\")
                (" "       . "\\\\P|\\n|\\t")
                ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                ("$1"      . "[\\\\]({)|{")
            )
        )
        (setq str
            (if mtx
                (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                (_Replace "\\"   "Ð" str)
            )
        )
        (vlax-release-object regex)
        str
    )

    ;==================================================================================
    ;    Main function
    ;==================================================================================
    (ssget '((0 . "text,mtext")))
    
    (setq doc  (vla-get-activedocument (vlax-get-acad-object))
          objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs)))
          tol  (car (vl-sort (mapcar 'vla-get-height objs) '<))
          objs (PTE:sortobj objs "rdr" tol)
    )
    
    (or (setq excel(vlax-get-or-create-object "Excel.Application"))
        (alert "Fail to Excel load") (exit)
    )
    (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add)
    (vlax-put Excel 'visible :vlax-true)
    (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells)
          x 1 y 1
    )
    
    (foreach os objs
        (foreach o os
            (setq str
                (if (= (vla-get-objectname o) "AcDbText") 
                    (vla-get-textstring o) 
                    (LM:UnFormat (vla-get-textstring o) nil)
                )
            )
            (vlax-put-property cell 'item y x (strcat "'" str))
            (setq x (1+ x))
        )
        (setq y (1+ y) x 1) 
    )(princ)
)


(defun c:TEXTEXPORTINCOLUMN( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat)

    ;    Sub-function - 01
    (defun PTE:sortobj

        (   olst typ tol /
            typ objs opt npt lst data lst rev sx sy dxf x y
            PTE:s1 PTE:s2 PTE:s3 PTE:s4
        )
        
        (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
        (defun sx  (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
        (defun sy  (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
        (defun dxf (o c)  (cdr  (assoc c (entget (vlax-vla-object->ename o)))))
        (defun x   (o)    (car  (dxf o 10)))
        (defun y   (o)    (cadr (dxf o 10)))
        
        (setq typ (vl-string->list (strcase typ)))
        
        (if (member (car typ) '(76 82))
            (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
            (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
        )
        
        (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
        
        (foreach o objs
            (if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
                (setq lst  (cons data lst) data (list o) opt npt)
                (setq data (cons o data))
            )
        )
        
        (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
              lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
              lst (if (member (car typ)  '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
              lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
        )
    )
    
    ;    Sub-function - 02
    (defun LM:UnFormat ( str mtx / _Replace regex )
        ;; ⓒ Lee Mac 2010
        (defun _Replace ( new old str )
            (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new)
        )
        (setq regex (vlax-get-or-create-object "VBScript.RegExp"))  
        (mapcar
            (function
                (lambda ( x ) (vlax-put-property regex (car x) (cdr x)))
            )
            (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
        )
        (mapcar
            (function
                (lambda ( x ) (setq str (_Replace (car x) (cdr x) str)))
            )
            '(
                ("Ð"       . "\\\\\\\\")
                (" "       . "\\\\P|\\n|\\t")
                ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                ("$1"      . "[\\\\]({)|{")
            )
        )
        (setq str
            (if mtx
                (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                (_Replace "\\"   "Ð" str)
            )
        )
        (vlax-release-object regex)
        str
    )

    ;==================================================================================
    ;    Main function
    ;==================================================================================
    (ssget '((0 . "text,mtext")))
    
    (setq doc  (vla-get-activedocument (vlax-get-acad-object))
          objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs)))
          tol  (car (vl-sort (mapcar 'vla-get-height objs) '<))
          objs (PTE:sortobj objs "rdr" tol)
    )
    
    (or (setq excel(vlax-get-or-create-object "Excel.Application"))
        (alert "Fail to Excel load") (exit)
    )
    (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add)
    (vlax-put Excel 'visible :vlax-true)
    (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells)
          x 1 y 1
    )
    
    (foreach os objs
        (foreach o os
            (setq str
                (if (= (vla-get-objectname o) "AcDbText") 
                    (vla-get-textstring o) 
                    (LM:UnFormat (vla-get-textstring o) nil)
                )
            )
            (vlax-put-property cell 'item y x (strcat "'" str))
            ;(setq x (1+ x)) ;edited line
	(setq y (1+ y) x 1) ;edited line
        )
        ;(setq y (1+ y) x 1) ;edited line
    )(princ)
)



(defun c:TEXTEXPORTINROW( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat)

    ;    Sub-function - 01
    (defun PTE:sortobj

        (   olst typ tol /
            typ objs opt npt lst data lst rev sx sy dxf x y
            PTE:s1 PTE:s2 PTE:s3 PTE:s4
        )
        
        (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
        (defun sx  (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
        (defun sy  (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
        (defun dxf (o c)  (cdr  (assoc c (entget (vlax-vla-object->ename o)))))
        (defun x   (o)    (car  (dxf o 10)))
        (defun y   (o)    (cadr (dxf o 10)))
        
        (setq typ (vl-string->list (strcase typ)))
        
        (if (member (car typ) '(76 82))
            (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
            (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
        )
        
        (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
        
        (foreach o objs
            (if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
                (setq lst  (cons data lst) data (list o) opt npt)
                (setq data (cons o data))
            )
        )
        
        (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
              lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
              lst (if (member (car typ)  '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
              lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
        )
    )
    
    ;    Sub-function - 02
    (defun LM:UnFormat ( str mtx / _Replace regex )
        ;; ⓒ Lee Mac 2010
        (defun _Replace ( new old str )
            (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new)
        )
        (setq regex (vlax-get-or-create-object "VBScript.RegExp"))  
        (mapcar
            (function
                (lambda ( x ) (vlax-put-property regex (car x) (cdr x)))
            )
            (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
        )
        (mapcar
            (function
                (lambda ( x ) (setq str (_Replace (car x) (cdr x) str)))
            )
            '(
                ("Ð"       . "\\\\\\\\")
                (" "       . "\\\\P|\\n|\\t")
                ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                ("$1"      . "[\\\\]({)|{")
            )
        )
        (setq str
            (if mtx
                (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                (_Replace "\\"   "Ð" str)
            )
        )
        (vlax-release-object regex)
        str
    )

    ;==================================================================================
    ;    Main function
    ;==================================================================================
    (ssget '((0 . "text,mtext")))
    
    (setq doc  (vla-get-activedocument (vlax-get-acad-object))
          objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs)))
          tol  (car (vl-sort (mapcar 'vla-get-height objs) '<))
          objs (PTE:sortobj objs "rdr" tol)
    )
    
    (or (setq excel(vlax-get-or-create-object "Excel.Application"))
        (alert "Fail to Excel load") (exit)
    )
    (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add)
    (vlax-put Excel 'visible :vlax-true)
    (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells)
          x 1 y 1
    )
    
    (foreach os objs
        (foreach o os
            (setq str
                (if (= (vla-get-objectname o) "AcDbText") 
                    (vla-get-textstring o) 
                    (LM:UnFormat (vla-get-textstring o) nil)
                )
            )
            (vlax-put-property cell 'item y x (strcat "'" str))
            (setq x (1+ x)) 
        )
        ;(setq y (1+ y) x 1) ;edited line
    )(princ)
)

 

maybe you want like this

command TEXTEXPORTINCOLUMN

 

I'm not original author of this code

add 2 options by just edit last 3 lines.

 

TEXTEXPORT : original lisp. justify rows and columns by it's location.

TEXTEXPORTINCOLUMN : 1 column export

TEXTEXPORTINROW : 1 row export

Edited by exceed
  • Agree 1
  • Thanks 1
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Maybe this, not tested save list as ((y X)(y x)....

  

; sorts on 1st two items
(vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
	    )
	  )
)

 

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

×
 Share
Go to topic listing
×
×
  • Create New...