请大神优化批量修改集中标注行距的程序
本帖最后由 tumu2008323 于 2016-2-1 13:27 编辑我改写了一个批量修改行距的插件，由于刚开始学，写的比较粗糙，比较啰嗦，目前还有几个bug，文字超出引线时，不能修改引线长度，还有一
项三种不能修改行距，请大神帮忙优化;;;====================================
;;;天若有情007 tumu2008323@163.com
;;;其中，引用了Lee Mac的修改行距以及最小包围圈为子程序
;;;
;;;===============================
;;;改集中标注行距，行距默认为1.2
;;;命令：ghj
;;;by 天若有情007 2016/02/01 V1.0
;;;
;;;
(defun c:ghj(/ ss ssl i j en enl enl_data en_data ptj dd ss_hj pt10 pt11 en_brh pthj1 pthj3 ptbrh1 ptbrh3)
(ycz_StoreSysVar)
(ycz_ChangeSysVar)
(command "undo" "be")
(setq jzbz_layer "S-BEAMCD-X-ANNO,S-BEAMCD-Y-ANNO");集中标注图层
;(setq LAYER_NEW "S-COMM-ELV")
(prompt "\n<<批量选择集中标注:>>")
(setq ss (ssget (list (cons 0 "TEXT") (cons 8 jzbz_layer))));集中标注
(prompt "\n<<批量选择引线:>>")
(setq ssl (ssget (list (cons 0 "LINE") (cons 8 jzbz_layer)));引线
i 0
ss_hj (ssadd)
)
(if ssl
(repeat (sslength ssl)
(setq enl (ssname ssl i)
j 0
enl_data (entget enl)
pt10 (cdr (assoc 10 enl_data))
pt11 (cdr (assoc 11 enl_data))
)
;(setq ss2 ss)
(repeat (sslength ss);文字循环查找
(setq en (ssname ss j)
en_data (entget en)
)
(ycz_dist);求文字到引线的距离
(if ptj;如果交点存在
(progn
(if (< dd 200)
(progn
(setq ss_hj (ssadd en ss_hj)
ss (ssdel en ss);如果已经循环过，则从ss中删除，但是好像有问题
j (1- j)
)
)
)
)
)
(setq j (1+ j))
)
(if ss_hj
(Lee_hj)
)
(if ss_hj
(progn
(LEE_BRH)
(setq en_brh (entlast))
;(ycz_rect en_brh)
(setq pthj1 (vlax-curve-getclosestpointto en_brh pt10)
pthj3 (vlax-curve-getclosestpointto en_brh pt11)
ptbrh1 (vlax-curve-getclosestpointto enl pthj1)
ptbrh3 (vlax-curve-getclosestpointto enl pthj3)
dd1 (distance pt10 pthj1)
dd3 (distance pt11 pthj3)
)
(entdel en_brh)
(if(< dd1 dd3)
(progn
(setq enl_data (subst (cons 10 ptbrh1) (assoc 10 enl_data) enl_data))
(entmod enl_data)
)
(progn
(setq enl_data (subst (cons 11 ptbrh3) (assoc 11 enl_data) enl_data))
(entmod enl_data)
)
)
)
)
(setq i (1+ i))
(setq ss_hj (ssadd))
)
)
(command "undo" "e")
(ycz_RestoreSysVar)
(prin1)
)
(defun ycz_StoreSysVar()
(setq vcmde (getvar "cmdecho"));普通命令的提示
(setq vblip (getvar "blipmode")) ;光标痕迹
(setq vclay (getvar "CLAYER")) ;图层
(setq vosmo (getvar "osmode")) ;捕捉模式
(setq vplwd (getvar "plinewid")) ;pl宽度
(setq Vlupr (getvar "luprec")) ;长度精度
(setq vlayer (getvar "clayer"));图层
(prin1)
)
(defun ycz_ChangeSysVar()
(setvar "cmdecho" 0);关闭命令响应
(setvar "osmode" 0);关闭捕捉
(command "ortho" 0);关闭正交
(prin1)
)
;还原系统变量
(defun ycz_RestoreSysVar()
(setvar "cmdecho" vcmde)
(setvar "blipmode" vblip)
(setvar "CLAYER" vclay)
(setvar "osmode" vosmo)
(setvar "plinewid" vplwd)
(setvar "luprec" Vlupr)
(command "ortho" 1)
(setvar "clayer" vlayer)
(prin1)
)
;求文字到直线距离
(defun ycz_dist ()
(command "ucs" "e" en)
(setqbox (textbox en_data)
p1(car box)
p1 (trans p1 1 0)
)
(command "ucs" "")
(setq ptj (vlax-curve-getclosestpointto enl p1))
(setq dd (distance p1 ptj))
(prin1)
)
;Lee的改行距程序
(defun Lee_hj ( / *error* bpt enx inc ins lst sel spf vec )
(setq spf 1.2) ;; 行距因子
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq inc (sslength ss_hj)
enx (entget (ssname ss_hj (1- inc)))
spf (polar '(0.0 0.0) (+ (cdr (assoc 50 enx)) (/ pi 2.0)) (* (cdr (assoc 40 enx)) spf))
vec (trans spf (trans '(0.0 0.0 1.0) 1 0 t) 0)
)
(repeat inc
(setq lst (cons (entget (ssname ss_hj (setq inc (1- inc)))) lst)
ins (cons (caddr (trans (aligntext:gettextinsertion (car lst)) (cdr (assoc -1 (car lst))) vec)) ins)
)
)
(setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>))
bpt (aligntext:gettextinsertion (car lst))
)
(LM:startundo (LM:acdoc))
(foreach itm (cdr lst)
(aligntext:puttextinsertion (setq bpt (mapcar '- bpt spf)) itm)
)
(LM:endundo (LM:acdoc))
(princ)
)
(defun aligntext:getdxfkey ( enx )
(if
(and
(zerop (cdr (assoc 72 enx)))
(zerop (cdr (assoc 73 enx)))
)
10 11
)
)
(defun aligntext:gettextinsertion ( enx )
(cdr (assoc (aligntext:getdxfkey enx) enx))
)
(defun aligntext:puttextinsertion ( ins enx )
( (lambda ( key )
(if (entmod (subst (cons key ins) (assoc key enx) enx))
(entupd (cdr (assoc -1 enx)))
)
)
(aligntext:getdxfkey enx)
)
)
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document-Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
;;;Lee的最小包容盒
(defun LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb )
(if ss
(progn
(setq bb
(LM:ListBoundingBox
(repeat (setq i (sslength ss))
(setq l (cons (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))) l))
)
)
)
(setq pr (* pr pi)
cn (apply 'mapcar (cons (function (lambda ( a b ) (/ (+ a b) 2.0))) bb))
cv (vlax-3D-point cn)
bm (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb)))
mb (cons 0.0 bb)
an 0
)
(while (< (setq an (+ an pr)) pi)
(foreach x l (vla-rotate x cv pr))
(setq bb (LM:ListBoundingBox l)
ba (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb)))
)
(if (< ba bm) (setq bm ba mb (cons an bb)))
)
(foreach x l (vla-delete x))
(LM:RotatePointsByMatrix
(mapcar
(function
(lambda ( a )
(mapcar (function (lambda ( b ) ((eval b) (cdr mb)))) a)
)
)
'((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
)
cn (- (car mb))
)
)
)
)
(defun LM:ListBoundingBox ( lst / l1 l2 ll ur )
(foreach obj lst
(vla-getboundingbox obj 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar
(function (lambda ( a b ) (apply 'mapcar (cons a b))))
'(min max) (list l1 l2)
)
)
(defun LM:RotatePointsByMatrix ( l p a / m )
(setq m
(list
(list (cos a) (sin (- a)) 0.0)
(list (sin a) (cos a) 0.0)
(list 0.0 0.0 1.0)
)
)
(setq p (mapcar '- p (mxv m p)))
(mapcar (function (lambda ( x ) (mapcar '+ (mxv m x) p))) l)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(defun LEE_BRH( / s )
;(princ "\n绘制最小包容盒:")
(if (setq s ss_hj)
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 1)
)
(mapcar '(lambda ( p ) (cons 10 p)) (LM:MinBoundingBox s 0.01))
)
)
)
(prin1)
)
(prompt "\n作者：天若有情007")
(prompt "\n<c:ghj>批量修改梁集中标注行距\n其中，引用了Lee Mac的修改行距以及最小包围圈为子程序")
(prin1)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 tumu2008323的微博 能多一个要求吗每行文字下面加条线 你好集中标注要在什么图层上
不知效果如何 MSTEEL工具箱 或 萝卜的拉移随心已经写得很好了。 brbright 发表于 2016-2-1 15:00 static/image/common/back.gif
MSTEEL工具箱 或 萝卜的拉移随心已经写得很好了。
位移随心的确是很好，但是位移随心不能批量修改啊，只能一个一个集中标注去拖，如果是那种大地库，就会要人命了啊 本帖最后由 kozmosovia 于 2016-2-2 11:40 编辑
根据引线长度及其角度为条件过滤选择文本并相应排序，然后直接将文本按顺序转换成多重文本，调整对齐方式、行间距及与引线关系。
最后根据需要分解多重文本（个人建议不要分解）
PS:
个人感觉最好的方案应该是带多重属性（标注文字）的动态块（拉伸引线）或者直接使用MLEADER 大师能写一个
批量修改标注文字和箭头大小的吗 本帖最后由 kozmosovia 于 2016-2-2 12:16 编辑
没有测试的图纸，都是以0层为过滤条件
(Defun C:abc (/ _TEXT2MTEXT _GETPER _GETMTEXTBOX _PROCESSLINE SS I)
(Defun _Text2MText (obj / LL MT P0 P1 STR UR)
(setq obj (entget obj)
str (cdr (assoc 1 obj))
)
(entmake (list (cons 0 "MTEXT")
(cons 8 (cdr (assoc 8 obj)))
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 (cdr (assoc 10 obj)))
(cons 40 (cdr (assoc 40 obj)))
(cons 41 0)
(cons 71 1)
(cons 72 5)
(cons 1 str)
(cons 7 (cdr (assoc 7 obj)))
(list 11 1.0 0.0 0.0)
(cons 50 (cdr (assoc 50 obj)))
)
)
(setq obj (vlax-ename->vla-object (cdr (assoc -1 obj)))
mt(vlax-ename->vla-object (entlast))
)
(vla-getboundingbox obj 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
p1 (vlax-3d-point (list (car ll) (cadr ur)))
)
(vla-getboundingbox mt 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
p0 (vlax-3d-point (list (car ll) (cadr ur)))
)
(vla-move mt p0 p1)
mt
)
(Defun _GetPer (pt pt1 pt2 / norm PerPt)
(cond ((equal pt1 pt2) nil)
((or (equal pt pt1) (equal pt pt2)) pt)
(t
(setq norm(mapcar '- pt2 pt1)
pt1 (trans pt1 0 norm)
pt (trans pt 0 norm)
PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
)
)
)
)
(Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) off) (- (cadar l) off))
(list (+ (caadr l) off) (- (cadar l) off))
(list (+ (caadr l) off) (+ (cadadr l) off))
(list (- (caar l) off) (+ (cadadr l) off))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) off) (- (cadr o) off))
(list (+ (car o) w off) (- (cadr o) off))
(list (+ (car o) w off) (+ (cadr o) h off))
(list (- (car o) off) (+ (cadr o) h off))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(Defun _ProcessLine (obj / A10 A11 ANG B10 B11 BOX
DDD DIS I INS LEFTMT O10 O11
OB PER RIGHT SSETSTR
)
(setq o10 (cdr (assoc 10 (entget obj)))
o11 (cdr (assoc 11 (entget obj)))
dis (* (distance o10 o11) 0.2)
ang (+ (* 0.5 pi) (angle o10 o11))
a10 (polar o10 ang dis)
a11 (polar o11 ang dis)
b10 (polar o10 ang (* dis -1.0))
b11 (polar o11 ang (* dis -1.0))
)
(if (setq i -1
sset (ssget "_cp"
(list a10 a11 b11 b10)
(list (cons 0 "text") (cons 8 "0"))
)
)
(progn
(repeat (sslength sset)
(setq obj (ssname sset (setq i (1+ i)))
box (_GetMTextBox obj 0.0)
)
(if (null (inters (car box) (last box) o10 o11 nil))
(progn
(setq per (_GetPer (car box) o10 o11)
ddd (list (distance per o10) obj)
)
(if (equal (angle per (car box))
(angle (car box) (cadr box))
0.01
)
(setq right (cons ddd right))
(setq left (cons ddd left))
)
)
)
)
(foreach abc (list left right)
(if abc
(progn
(setq abc (vl-sort abc
'(lambda (p1 p2) (< (car p1) (car p2)))
)
abc (mapcar 'last abc)
box (_GetMTextBox (car abc) 0.0) str nil
)
(if (equal (angle o10 o11)
(angle (car box) (last box))
0.01
)
(setq abc (reverse abc))
)
(foreach ob abc
(if (null str)
(setq str (cdr (assoc 1 (entget ob))))
(setq
str (strcat str "\\P" (cdr (assoc 1 (entget ob))))
)
)
)
(setq ob (_Text2MText (car abc))
box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
ins (last box)
per (_GetPer ins o10 o11)
ins (polar
per
(angle per ins)
(cdr
(assoc 40 (entget (vlax-vla-object->ename ob)))
)
)
)
(vla-put-textstring ob str)
(if
(not
(equal
(angle per ins)
(cdr (assoc 50 (entget (vlax-vla-object->ename ob)))
)
0.01
)
)
(vla-put-AttachmentPoint ob acAttachmentPointTopRight)
)
(vla-put-insertionpoint ob (vlax-3d-point ins))
(mapcar 'entdel abc)
)
)
)
)
)
)
(if (setq i-1
ss (ssget (list (cons 0 "line") (cons 8 "0")))
)
(repeat (sslength ss)
(_ProcessLine (ssname ss (setq i (1+ i))))
)
)
)
kozmosovia 发表于 2016-2-2 11:57 static/image/common/back.gif
没有测试的图纸，都是以0层为过滤条件
多谢大神出手，程序很棒，但是有两个问题还没有找到原因，一个是原来的钢筋符号变成了%%153，而不显示钢筋符号，第二个是不能调整引线长度，希望大神方便可以修改一下
本帖最后由 kozmosovia 于 2016-2-2 17:00 编辑
特殊钢筋符号这些MTEXT处理起来可能只能使用TTF替换，但是这样与他人的兼容可能会出现问题，因此估计只能再把MTEXT分解成TEXT。
引线头部削平了
(Defun C:abc2 (/ _TEXT2MTEXT _GETPER _GETMTEXTBOX
_PROCESSLINE_CHANGEALIGN_GETMID SS
I
)
(Defun _Text2MText (obj / LL MT P0 P1 STR UR)
(setq obj (entget obj)
str (cdr (assoc 1 obj))
)
(entmake (list (cons 0 "MTEXT")
(cons 8 (cdr (assoc 8 obj)))
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 (cdr (assoc 10 obj)))
(cons 40 (cdr (assoc 40 obj)))
(cons 41 0)
(cons 71 1)
(cons 72 5)
(cons 1 str)
(cons 7 (cdr (assoc 7 obj)))
(list 11 1.0 0.0 0.0)
(cons 50 (cdr (assoc 50 obj)))
)
)
(setq obj (cdr (assoc -1 obj))
p1 (_GetMTextBox obj)
p1 (vlax-3d-point (_GetMid (car p1)(caddr p1)))
mt(entlast)
p0 (_GetMTextBox mt)
p0 (vlax-3d-point (_GetMid (car p0)(caddr p0)))
mt (vlax-ename->vla-object mt)
)
(vla-move mt p0 p1)
mt
)
(Defun _GetPer (pt pt1 pt2 / norm PerPt)
(cond ((equal pt1 pt2) nil)
((or (equal pt pt1) (equal pt pt2)) pt)
(t
(setq norm(mapcar '- pt2 pt1)
pt1 (trans pt1 0 norm)
pt (trans pt 0 norm)
PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
)
)
)
)
(Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) off) (- (cadar l) off))
(list (+ (caadr l) off) (- (cadar l) off))
(list (+ (caadr l) off) (+ (cadadr l) off))
(list (- (caar l) off) (+ (cadadr l) off))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) off) (- (cadr o) off))
(list (+ (car o) w off) (- (cadr o) off))
(list (+ (car o) w off) (+ (cadr o) h off))
(list (- (car o) off) (+ (cadr o) h off))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(Defun _ProcessLine (obj / A10 A11 ALI ANG B10 B11
BOX DDD DIS EPT I INS LEFT LIN
O10 O11 OB PER RIGHT SPT SS SSET
STR THH
)
(setq o10 (cdr (assoc 10 (entget obj)))
o11 (cdr (assoc 11 (entget obj)))
dis (* (distance o10 o11) 0.2)
ang (+ (* 0.5 pi) (angle o10 o11))
a10 (polar o10 ang dis)
a11 (polar o11 ang dis)
b10 (polar o10 ang (* dis -1.0))
b11 (polar o11 ang (* dis -1.0))
lin (vlax-ename->vla-object obj)
)
(if (setq i -1
sset (ssget "_cp"
(list a10 a11 b11 b10)
(list (cons 0 "text") (cons 8 "0"))
)
)
(progn
(repeat (sslength sset)
(setq obj (ssname sset (setq i (1+ i)))
box (_GetMTextBox obj 0.0)
)
(if (null (inters (car box) (last box) o10 o11 nil))
(progn
(setq per (_GetPer (car box) o10 o11)
ddd (list (distance per o10) obj)
)
(if (equal (angle per (car box))
(angle (car box) (cadr box))
0.01
)
(setq right (cons ddd right))
(setq left (cons ddd left))
)
)
)
)
(foreach abc (list left right)
(if abc
(progn
(setq abc (vl-sort abc
'(lambda (p1 p2) (< (car p1) (car p2)))
)
abc (mapcar 'last abc)
box (_GetMTextBox (car abc) 0.0)
str nil
)
(if (equal (angle o10 o11)
(angle (car box) (last box))
0.01
)
(setq abc (reverse abc))
)
(foreach ob abc
(if (null str)
(setq str (cdr (assoc 5 (entget ob))))
(setq
str (strcat str "\\P" (cdr (assoc 5 (entget ob))))
)
)
)
(setq ob (_Text2MText (car abc))
box (vla-put-textstring ob str)
box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
ins (last box)
spt (_GetPer (last box) o10 o11)
thh (cdr
(assoc 40 (entget (vlax-vla-object->ename ob)))
)
ins (polar spt (angle spt (last box)) (* 0.5 thh))
)
(if
(not
(equal
(angle spt ins)
(cdr (assoc 50 (entget (vlax-vla-object->ename ob)))
)
0.01
)
)
(setq ali acAttachmentPointTopRight)
(setq ali acAttachmentPointTopLeft)
)
(vla-put-AttachmentPoint ob ali)
(vla-put-insertionpoint ob (vlax-3d-point ins))
(setq box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
spt (_GetPer (last box) o10 o11)
ept (_GetPer (car box) o10 o11)
mid (_GetMid spt ept)
ept (polar ept (angle mid ept) (* 0.2 thh))
spt (polar spt (angle mid spt) (* 0.2 thh))
)
(if (> (distance o10 mid) (distance o11 mid))
(setq mid o10)
(setq mid o11)
)
(if (equal (distance spt mid)
(+ (distance ept mid)
(distance spt ept)
)
0.01
)
(setq ept mid)
(setq spt mid)
)
(vla-put-startpoint lin (vlax-3d-point spt))
(vla-put-endpoint lin (vlax-3d-point ept))
(command "_.Explode" (vlax-vla-object->ename ob))
(setq i-1
ss (ssget "_p")
)
(repeat (sslength ss)
(if (setq ob(vlax-ename->vla-object
(ssname ss (setq i (1+ i)))
)
ob(_ChangeAlign ob ali)
abc (handent (vla-get-textstring ob))
)
(setq abc (vlax-ename->vla-object abc)
ob(vla-put-textstring ob (vla-get-textstring abc))
abc (vla-erase abc)
)
)
)
)
)
)
)
)
)
(Defun _GetMid (p1 p2)
(polar p1 (angle p1 p2) (* 0.5 (distance p1 p2)))
)
(Defun _ChangeAlign (vlo ali / BOX BOY)
(if (= ali acAttachmentPointTopRight)
(progn
(setq box (_GetMTextBox (vlax-vla-object->ename vlo) 0.0)
box (_GetMid (car box) (caddr box))
)
(vla-put-alignment vlo acAlignmentRight)
(setq boy (_GetMTextBox (vlax-vla-object->ename vlo) 0.0)
boy (_GetMid (car boy) (caddr boy))
)
(vla-move vlo (vlax-3d-point boy) (vlax-3d-point box))
)
)
vlo
)
(if (setq i-1
ss (ssget (list (cons 0 "line") (cons 8 "0")))
)
(repeat (sslength ss)
(_ProcessLine (ssname ss (setq i (1+ i))))
)
)
)
kozmosovia 发表于 2016-2-2 13:31 static/image/common/back.gif
特殊钢筋符号这些MTEXT处理起来可能只能使用TTF替换，但是这样与他人的兼容可能会出现问题，因此估计只能再 ...
结构佬必须顶
页:
[1]
2