[源码] 相同文字连线如何加入属性块文字

admin

(defun c:tt (/ *ent2obj* entbox get-dxf getmidpo olayer oldliness po px ss ss2list sslst str str2 ttent tylx)
  (setq *ent2obj*     vlax-Ename->Vla-Object)
  ;;单个物体的最小（正交）包围框
  (defun entbox ( ent / ll ur )
    (vla-getboundingbox (*ent2obj* ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  ;;求两点中点
  (defun getmidpo( pts / P1 P2 X Y )
    (setq p1 (car pts) p2 (cadr pts))
    (if (= (length p1) (length p2))
      nil
      (setq p1 (list (car p1) (cadr p1))
        p2 (list (car p2) (cadr p2))
      )
    )
    (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
  )
  ;;选择集转为图元列表
  (defun ss2list( ss )
    (reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
  )
  (defun get-dxf(en n)
    (if (not (listp en)) (setq en (entget en)))
    (cdr (assoc n en))
  )
  (setq olayer (getvar "clayer"))
  (command "layer" "m" "f采用temp采用文字连线" "c" "6" "" "")
  (setvar "cmdecho" 0)
  (if (setq ss (ssget ":e:s" '(
                                (-4 . "<OR")
                                (-4 . "<AND")(0 . "TEXT")(-4 . "AND>")
                                (-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>")
                                (-4 . "OR>")
                              )
               )
      )
    (progn
      (setq ttent (ssname ss 0))
      (setq tylx (get-dxf ttent 0))
      (cond
        ((= tylx "TEXT")
          (setq str (cdr (assoc 1 (entget ttent))))
        )
        ((= tylx "INSERT")
          (setq str (car (mapcar '(lambda (x) (vla-get-textstring x)) (vlax-invoke (vlax-ename->vla-object ttent) "getattributes"))))
        )
      )
      (setq po (getmidpo (entbox ttent)))
      (setq ss (ssget "x" (list
                            '(-4 . "<OR")
                            '(-4 . "<AND")'(0 . "TEXT")(cons 1 str)'(-4 . "AND>")
                            '(-4 . "<AND")'(0 . "INSERT")'(66 . 1)'(-4 . "AND>")
                            '(-4 . "OR>")
                          )
               )
      )
      (setq sslst '())
      (foreach ty (ss2list ss)
        (setq tylx (get-dxf ty 0))
        (if (= tylx "INSERT")
          (progn
            (setq str2 (car (mapcar '(lambda (x) (vla-get-textstring x)) (vlax-invoke (vlax-ename->vla-object ty) "getattributes"))))
            (if (/= str str2)
              (ssdel ty ss)
            )
          )
        )
      )
      (if (< 1 (sslength ss))
        (progn
          (setq oldliness (ssget "x" '((0 . "line")(8 . "f采用temp采用文字连线"))))
          (if oldliness (command "erase" oldliness ""))
          (setq ss (vl-remove ttent (ss2list ss)))
          (foreach x ss
            (setq px (getmidpo (entbox x)))
            (command "line" "non" po "non" px "")
          )
        )
        (command "change" ttent "" "p" "co" "2" "")
      )
    )
  )
  (setvar "clayer" olayer)
  (princ)
)