Can anybody help to sort the data of AUTOCAD by vlisp?

[skchui6159]

Hello everyone. As I have many batch or data , I want to ask that can I extract the data for beam mark and size to excel ordering by vlisp.

The pattern like that

... to excel or txt or csv is ok.

[LDShaw · Accepted solution]

If I am interpreting you correctly all you want to do is batch out a dataextraction off text?
I notice your text is both mtext RTF and text. 

This is fairly simple.

To help people figure out your real needs can you put the steps you'd like done in a simple order? As an example.

1. open dwg
2. Clean up text  

run stripMtext 
add some sort of delimiter.  (this won't work. the lmb is both text and mtext.

(defun c:foo ( / ss i obj text)
  (load "stripmtext.lsp")
  (setq ss (ssget "X" '((0 . "MTEXT"))))
  (if ss
    (progn
      (StripMtext ss '("c" "f" "h" "q" "o" "s" "t" "u" "w" "n"))
      (setq i 0)
      (while (< i (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss i)))
        (setq text (vla-get-TextString obj))
        (vla-put-TextString obj (strcat text "-"))
        (setq i (1+ i))
      )
    )
  )
  (princ)
)

3. run lisp to combine text or somehow link lmrb to size. (I see the lmbr and size are swapped often with no rhyme or reason to order or text style that I can see.)
4. run dataextraction
5. close file
6. repeat with next file in folder.

If the list of files are in different folders you need to tell us how you go about selecting them. We need solid steps that a computer can perform or places where human interactions are needed. If interaction is needed then automating this will be a little harder. (not impossible)

@Kent1Cooper until @skchui6159 comes back with answers I was going to leave it alone. 
BUT since it's started. 

I was envisioning creating a couple of lisp routines to clean up the text then using in WScript but until skchui6159 really explains what is wanted it's all speculation. 

PS sorry for appending my original post but I did not want to clutter the thread up. 
 

[Kent1Cooper · Accepted solution]

---

@LDShaw wrote:

....
2. run striptext
....

---

That would be STRIPMTEXT [available in various places like >here< if you don't already have it].  The Mtext objects in the drawing look so simple that I was going to suggest simply EXPLODE-ing them instead, but I find there's a wild mish-mash of internal formatting combinations in many of them.  Some have none, but I found one with three internal font override assignments, all to the same font.  Each change in formatting, even when like those it has no effect on the appearance, means a separation between resulting Text objects after Exploding [that one turned into five Text objects].  So I think something like StripMtext is going to be necessary if they need to be singular and whole for extraction purposes.

[skchui6159]

Thank you, very helpful.

I also I want to ask that can you show the actual lisp work out by video?

Because My autoCAD nothing happen when using the code. Thank you 😅

[skchui6159]

That great! the Format for content are removed!

[LDShaw · Accepted solution]

All that little snippit would do is load then run the stripmtext.lsp command. Then it would put a "-" at the end of the mtext lines. (The first time I looked at your dwg I only saw mtext on the lmb lines. Later I saw everything was mixed.)
You would not see much at all done to the files.
Kent is probably right. Dropping everything to text then working from there may be a better way to go.


Until I have a better handle on what you're really trying to accomplish I'm going to leave this alone.
By a better handle I mean.

How are you doing this now?
What is the end result?
The more steps you give the better the eventual solution can be.

[skchui6159]

Finally, I use select similar and put them cover each other like that.

then use DATAEXTRACTION to solve it. Finally, I am using vba of EXCEL to sort by X position  (First) then Y position (Second) then Value(Third). And rearrange the position and completed. Sorry, I think it is really hard to extract the data by lisp in this special case.

[LDShaw]

Glad it works for you!
My geek side says with a little effort it could be automated even more. It's all a balance of how many files you have verses how long the creation of the lsps take. I have batched several hundred files doing something similar. For me it was worth the pain of creating the scripts.

[Moshe-A · Accepted solution]

@skchui6159  hi,

Although you already close this, here is my complete version 😀

Command: LMRB  (you can change this to what ever you like)

It starts with select objects, than goes to find the pair of texts. we assume that a pair of texts are one above another and the distance between them is maximum of the cumulative text heights + a factor set to 1.5 by default

(setq FACT-CLOSE 1.5) ; const

if you'll find some not paired text, change this to more suitable value (but not less than 1.0)

at end unpaired texts will be highlight and selected.

this command also rely on the amazing (LM:UnFormat) function by Lee Mac.

enjoy

Moshe

;;-------------------=={ 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) ; load ActiveX support


(defun c:lmrb (/ getMiddlePoint getCloseText isPairTexts getTextValue summarize ; local functions
		 FACT-CLOSE ss0 ss1 ss2 ss3 ename0 ename1 text p p0 item2 pair pairs^ fname fullpath f)

 ; return middle point of text
 (defun getMiddlePoint (ename / AcDbText Lower Upper)
  (setq AcDbText (vlax-ename->vla-object ename))
  (vla-getBoundingBox AcDbText 'Lower 'Upper)
  (vlax-release-object AcDbText)

  (mapcar
    (function
      (lambda (x0 x1)
       (/ (+ x0 x1) 2)
      )
    ); function
   (vlax-safearray->list Lower)
   (vlax-safearray->list Upper)
  ); mapcar
 ); getMiddlePoint 


 ; build data list - return the closet text
 (defun getCloseText (pt ss / ename)
  (car
    (vl-sort    
     (mapcar
       (function
	(lambda (ename)
         (list (getMiddlePoint ename) ename)
	); lambda
       ); function
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     ); mapcar
     (function (lambda (e0 e1) (< (distance pt (car e0)) (distance pt (car e1)))))
    ); vl-sort
  ); car
 ); getCloseText


 ; return T if texts are close inbound
 (defun isPairTexts (t1 ent1 t2 ent2 / h1 h2)
  (setq h1 (cdr (assoc '40 (entget ent1))))
  (setq h2 (cdr (assoc '40 (entget ent2))))

  (< (distance t1 t2) (* (+ h1 h2) FACT-CLOSE))
 ); isPairTexts


 ; get text/mtext value
 (defun getTextValue (ename / elist)
  (setq elist (entget ename))

  (if (eq (cdr (assoc '0 elist)) "TEXT")
   (cdr (assoc '1 elist))
   (LM:UnFormat (cdr (assoc '1 elist)) t)
  )
 ); getTextValue


 ; highlight not paired text
 (defun summarize (s2 s3 / i s0 p)
  (cond
   ((and (> (sslength s2) 0) (not s3))
    (setq s0 s2)
   ); case
   ((and (> (sslength s2) 0) (> (sslength s3) 0))
    ; concatinate selections
    (setq i -1 s0 (ssadd))
    (foreach p (list s2 s3)
     (repeat (sslength p)
      (ssadd (ssname p (setq i (1+ i))) s0)
     ); repeat
    ); foreach
   ); case
  ); cond
   
  (vlr-beep-reaction)
  (princ (strcat "\n" (itoa (sslength s0)) " text(s) no paired."))
  (sssetfirst nil s0)
 ); summarize
  

 ; here start c:lmrb
 (setq FACT-CLOSE 1.5) ; const
  
 (if (setq ss0 (ssget '((0 . "text,mtext"))))
  (progn
   (if (< FACT-CLOSE 1.0) (setq FACT-CLOSE 1.0)) ; FACT-CLOSE can not be less then 1
   
   (setq ss1 (ssadd) ss2 (ssadd))
   (foreach ename0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
    (setq elist0 (entget ename0))
     
    (if (eq (strcase (cdr (assoc '0 elist0))) "TEXT")
     (setq text (cdr (assoc '1 (entget ename0))))
     (setq text (LM:UnFormat (cdr (assoc '1 elist0)) t))
    )
     
    (cond
     ((eq (strcase (substr text 1 4)) "LMRB")
      (ssadd ename0 ss1)
     ); case
     ((and
	(or
	  (setq p (vl-string-search "x" text))
	  (setq p (vl-string-search "X" text))
	)
	(eq (type (read (substr text 1 p))) 'INT)
	(eq (type (read (substr text (+ p 2)))) 'INT)
      )
      (ssadd ename0 ss2)
     ); case
    ); cond
   ); foreach

   (if (/= (sslength ss2) 0)
    (progn
     (setq ss3 (ssadd)) ; for not paired
   
     (foreach ename1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
      (setq p0 (getMiddlePoint ename1))
      (setq item2 (getCloseText p0 ss2))

      (if (isPairTexts p0 ename1 (car item2) (cadr item2))
       (progn
        (setq pairs^ (cons (list (substr (getTextValue ename1) 1 7) ename1 (cadr item2)) pairs^))
        (ssdel (cadr item2) ss2) ; remove the 2nd ename from ss2
                                 ; if ss2 still remain with objects, they are not paired
       ); progn
       ; else
       (ssadd ename1 ss3) ; store not paired
      ); if
     ); foreach

   
     ; Creating CSV file
     (setq fname (strcat (getvar "dwgprefix") (getvar "dwgname")))
     (setq fullpath (strcat (vl-filename-directory fname) "\\" (vl-filename-base fname) ".csv"))

     (if (findfile fullpath)
      (vl-file-delete fullpath)
     )
   
     (if (not (setq f (open fullpath "w"))) ; open excel file
      (progn
       (vlr-beep-reaction)
       (princ (strcat "\ncan not open " fullpath " for write."))
      ); progn
      (progn
       (princ (strcat "\nCreating " fullpath " file."))
       (write-line "BEAM MARK,SIZE" f) ; excel file header
       (foreach pair (vl-sort pairs^ (function (lambda (e0 e1) (< (car e0) (car e1))))) ; sort by beam mark
        (write-line (strcat (getTextValue (cadr pair)) "," (getTextValue (caddr pair))) f)
       ); foreach

       (setq f (close f))  ; close excel file
       (summarize ss2 ss3) ; highlight - not paired
      ); progn
     ); if
     
    ); progn
    (summarize ss1 nil) ; highlight - noting paired
   ); if
   
  ); progn
 ); if
	   
 (princ)
); c:lmrb

[skchui6159]

 You did a great work! It is exactly what I want to do! Thank you very much!!!!!!!!!Cheer!