[编程交流] 组合文本字符串

(defun c:test (/ ENT ENT1 HND HND1 ITM MN MX NUM P1 P2 P3 SS SS1 STR)
 (if (setq ss (ssget "_:L" '((0 . "TEXT") (1 . "#*`[##`/##"))))
   (progn
     (setq itm 0
    num (sslength ss)
     )
     (while (< itm num)
(setq hnd (ssname ss itm)
      ent (entget hnd)
)
(vla-getboundingbox (vlax-ename->vla-object hnd) 'mn 'mx)
(setq p1 (vlax-safearray->list mn)
      p2 (vlax-safearray->list mx)
)
(setq
  p3 (list (+ (- (car p2) (car p1)) (car p2)) (cadr p1) (caddr p2))
)
(if (setq ss1 (ssget "_C" p2 p3 '((0 . "TEXT") (1 . "@=#*"))))
  (progn
    (setq hnd1 (ssname ss1 0)
   ent1 (entget hnd1)
   str  (strcat (cdr (assoc 1 ent)) " " (cdr (assoc 1 ent1)))
    )
    (entmod (subst (cons 1 str) (assoc 1 ent) ent))
    (entdel hnd1)
  )
)
(setq itm (1+ itm))
     )
   )
 )
 (princ)
)

(setq ent (subst (cons 1 str) (assoc 1 ent) ent)
     ent (subst (cons 8 "JOINED") (assoc 8 ent) ent)                  
)
(entmakex ent)

(setq ent (subst (cons 1 str) (assoc 1 ent) ent)
     ent (subst (cons 8 "JOINED") (assoc 8 ent) ent)                  
)
(entmakex ent)

(defun c:test (/ ENT ENT1 HND ITM MN MX NUM P1 P2 P3 SS SS1 STR)
 (if (setq ss (ssget "_:L" '((0 . "TEXT") (1 . "#*`[##`/##"))))
   (progn
     (setq itm 0
    num (sslength ss)
     )
     (while (< itm num)
(setq hnd (ssname ss itm)
      ent (entget hnd)
)
(vla-getboundingbox (vlax-ename->vla-object hnd) 'mn 'mx)
(setq p1 (vlax-safearray->list mn)
      p2 (vlax-safearray->list mx)
)
(setq
  p3 (list (+ (- (car p2) (car p1)) (car p2)) (cadr p1) (caddr p2))
)
(if (setq ss1 (ssget "_C" p2 p3 '((0 . "TEXT") (1 . "@=#*"))))
  (progn
    (setq ent1 (entget (ssname ss1 0))
   str (strcat (cdr (assoc 1 ent)) " " (cdr (assoc 1 ent1)))
   ent (subst (cons 1 str) (assoc 1 ent) ent)
   ent (subst (cons 8 "JOINED") (assoc 8 ent) ent)
    )
(entmakex ent)
  )
)
(setq itm (1+ itm))
     )
   )
 )
 (princ)
)

 Found Items: 264
Matched Items: 262
Vert. Offset: 18.75

(defun c:jtxt (/ ent ent1 hnd hnd1 itm mn mx num p1 p2 p3 ss ss1 str)
 (if (setq ss (ssget "_:L" '((0 . "TEXT") (1 . "#*`[##`/##"))))
   (progn
     (setq ofs (* (cdr (assoc 40 (entget (ssname ss 0)))) 1.25)
           itm 0
           jcount 0
           num (sslength ss)
     )
     (while (< itm num)
       (setq hnd (ssname ss itm)
             ent (entget hnd)
       )
       (vla-getboundingbox (vlax-ename->vla-object hnd) 'mn 'mx)
       (setq p1 (vlax-safearray->list mn)
             p2 (vlax-safearray->list mx)
       )
       (setq
         p3 (list (+ (- (car p2) (car p1)) (car p2)) (cadr p1) (caddr p2))
       )
       (if (setq ss1 (ssget "_C" p2 p3 '((0 . "TEXT") (1 . "@=#*"))))
         (progn
           (setq hnd1 (ssname ss1 0)
                 ent1 (entget hnd1)
                 str  (strcat (cdr (assoc 1 ent)) " " (cdr (assoc 1 ent1)))
                 loc  (cdr (assoc 10 ent))
                 loc  (list (car loc) (+ (cadr loc) ofs) (caddr loc))
           )
           (setq ent (subst (cons 1 str) (assoc 1 ent) ent)
                 ent (subst (cons 8 "JOINED") (assoc 8 ent) ent)
                 ent (subst (cons 10 loc) (assoc 10 ent) ent)
                 ent (subst (cons 11 loc) (assoc 11 ent) ent)
                 ent (subst (cons 72 0) (assoc 72 ent) ent) 
           )
           (entmake ent)
           (setq jcount (1+ jcount))
         )
       )
       (setq itm (1+ itm))
     )
   )
 )
 (princ (strcat "\n  Found Items: " (itoa itm)
                "\nMatched Items: " (itoa jcount)
                "\n Vert. Offset: " (rtos ofs 2 2)
        )
 )       
 (princ)
)