tanle2020 发表于 2013-5-31 13:15:40

普通引线文字改为CAD式关联引线文字

cad的引线文字标注非常好用，引线能够随文字移动和随文字长短改变引线线长，现在想把以前老图里面的普通引线文字标注改为关联式的引线文字标注怎么实现，请求帮助！


ZZXXQQ 发表于 2013-5-31 13:15:41

本帖最后由 ZZXXQQ 于 2013-6-4 08:44 编辑

做了一个，不理想。算是抛砖引玉吧。(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "*TEXT")))) (progn
(setq i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ent (entget en)
txtbox (textbox ent)
pt (cdr(assoc 10 ent))
txt (cdr(assoc 1 ent))
p1 (mapcar '+ pt (car txtbox))
p2 (mapcar '+ p1 (cadr txtbox))
p3 (mapcar '+ (list (car p2) (cadr p1)) '(5 -5))
p4 (mapcar '+ (list (car p1) (cadr p2)) '(-5 5)))
(if (setq ss1 (ssget "C" p2 p4 '((0 . "LEADER")))) (progn
(setq en1 (ssname ss1 0) ent1 (entget en1))
(setq plst (list))
(foreach x ent1 (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq plst (reverse plst))
(command "_.LEADER" (car plst) (cadr plst) "" txt "")
(entdel en)
(entdel en1)
))
)
))
(setvar "CMDECHO" 1)
(princ)
)

tanle2020 发表于 2013-6-3 08:46:29

ZZXXQQ 发表于 2013-5-31 23:12 static/image/common/back.gif
做了一个，不理想。算是抛砖引玉吧。

非常感谢ZZXXQQ版主出手，功能已经差不多达到了，只是下图反方向的无反应。希望版主能够完善一下。

ZZXXQQ 发表于 2013-6-4 08:44:54

沙发改了，再试试。

tanle2020 发表于 2013-6-4 09:21:42

ZZXXQQ 发表于 2013-6-4 08:44 static/image/common/back.gif
沙发改了，再试试。

左右方向都无反应了，还有(textbox ent)貌似对多行文字出错。

Michael_GM 发表于 2013-7-30 12:53:48

再试试

vladimir 发表于 2016-10-24 16:10:13

很不错的程序，谢谢楼主分享啊。
页: [1]
查看完整版本: 普通引线文字改为CAD式关联引线文字