[程序分享] 同名圖塊連線

(setq *ent2obj*     vlax-Ename->Vla-Object)

(defun c:fbb()
  (if (setq ss (ssget ":e:s" '((0 . "INSERT")))) ;选择类型，创建选择集
                (progn
                        (setq ttent (ssname ss 0))
                        (command "layer" "m" "f_temp_文字连线" "c" "6" "" "")
                        (setq str (cdr (assoc 2 (entget ttent))))
                        (setq po (getmidpo (entbox ttent)))
                        (setq ss (ssget "x" (list '(0 . "insert")(cons 2 str))))
                        (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" "")
                        )
                )
        )
        (princ)
)

;;单个物体的最小（正交）包围框
(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 )
        (if (= 'PICKSET (type ss))
                (reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
        )
)