@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
