刚刚随手编的一个相同文字连线的小程序

masterlong

刚刚随手编的一个相同文字连线的小程序
对某些同学或许有点用


现在的设备、工艺专业人员都挺偷懒
按规矩应该在设备编号旁边注明电功率等内容
现在是啥也不标就给个设备表
核对起来很费时
这个程序就是点设备表的文字
自动在所有相同的文字之间连上直线
程序很简单扩展空间很大

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

(defun c:tt()
  (if (setq ss (ssget ":e:s" '((0 . "TEXT"))))
  (progn
   (setq ttent (ssname ss 0))
   (command "layer" "m" "f_temp_文字连线" "c" "6" "" "")
   (setq str (cdr (assoc 1 (entget ttent))))
   (setq po (getmidpo (entbox ttent)))
   (setq ss (ssget "x" (list '(0 . "TEXT")(cons 1 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))))
)
)

偶尔郁闷

up                       

whs51601

文字连线？有什么用吗？没有示意图

xuningxu

好工具。加个连线的框选范围

USER2128

楼主可参考“http://bbs.mjtd.com/thread-110686-1-1.html”、http://bbs.xdcad.net/thread-678605-1-1.html

434939575

这个挺好的

doro

这个还挺实用

伪书虫86

谢谢龙前辈，这个挺好，以前找不到，都是用查找的，用这个就方便多了

zhengchuan

好工具。如果在连线前可以选择范围就更好啦。

小灰345

学习了！！！！！

lyqiezi

我是用遍历zoom的方式，检查某个编号构件跟表格的是否一致

zhengchuan

能不能加个连线的框选范围啊

无花老和尚

能不能连块啊