[求助]动态引线的箭头方向怎么判断？（已解决）
本帖最后由 作者 于 2009-2-27 22:37:14 编辑 <br /><br /> <p> 想弄一个引线会跟着鼠标移动走的，用来做局部放大用，但当鼠标移到对象的另一边时，引线就反了，请问怎样可以把左边那个改成像右边那个一样？有劳诸位大侠，谢谢！！</p><p>还有，鼠标的十字线能不能暂时隐藏掉？</p><p></p> 增加一句就可以了.(vla-put-VerticalTextPosition Leader 1)
(defun c:test (/ ent mspace i m wenzi a b c d aa bb cc dd ee ff gg leader)
(setq ent (car (entsel)));;选择对象
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq i T)
(while i
(setq a (grread T 4 0) b (car a) c (cadr a)) ;;b=5移动，b=3左键,c=0右键,;;c=13回车,c=32空格
(cond ((= b 5) ;当鼠标移动时
(setq a (trans (cadr a) 1 0)) ;;鼠标移动点
(setq d (vlax-curve-getclosestpointto ent a)) ;;a到对象ent的最近点
(setq aa (car a) bb (cadr a) cc (caddr a)) ;;提取 a 的x,y,z
(setq dd (car d) ee (cadr d) ff (caddr d)) ;;提取 d 的x,y,z
;;★创建引线★
(setq gg (vlax-make-safearray vlax-vbDouble '(0 . 5)))
(vlax-safearray-fill gg (list dd ee ff aa (- (cadr a) 2) cc));;填满gg
(if (not Leader);;如果leader为空
(progn
(setq m (vla-AddMText mspace (vlax-3d-point (list aa (- (cadr a) 1.5))) 0 "A")) ;;创建文字A
(setq wenzi (vlax-make-safearray vlax-vbString '(1 . 9)))
(vlax-safearray-fill wenzi '("TopLeft" "TopCenter" "TopRight" "MiddleLeft"
"MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")) ;;填满wenzi
(setq Leader (vla-AddLeader mspace gg m acLineWithArrow));;创建有箭头的引线
) ;;end_progn
);;end_if
(if (<= aa dd) ;;如果鼠标移动点的x坐标值小于等于最近点的X坐标值
(vla-put-AttachmentPoint m 9) ;;更改文字的贴附点为9（右下角）
(vla-put-AttachmentPoint m 7) ;;更改文字的贴附点为7（左下角）
);;end_if
(vla-put-InsertionPoint m (vlax-3d-point (list aa (- (cadr a) 1.5))));;更新文字插入点
(vla-put-Coordinates Leader gg) ;;更新引线插入点
(vla-put-VerticalTextPosition Leader 1)
) ;;end_cond第一个括号
((= b 3) (setq i nil)) ;;左键结束while（cond第二个括号）
) ;;end_cond
) ;;end_while
(princ)
)
本帖最后由 作者 于 2009-3-2 19:55:40 编辑 <br /><br /> userzhl发表于2009-3-1 21:45:00static/image/common/back.gif可不可以改成这样?
<p></p>(defun C:as () ;;水平--垂直标注互换 <br/>(Setvar "CMDECHO" 0)<br/>(if (and (= (getvar "dimtoh") 0) (= (getvar "dimtih") 0))<br/> (progn <br/> (Setvar "dimtoh" 1)<br/> (Setvar "dimtih" 1)<br/> (prompt "\n水平标注")<br/> )<br/> (progn <br/> (Setvar "dimtoh" 0)<br/> (Setvar "dimtih" 0)<br/> (prompt "\n与尺寸线对齐")<br/> )<br/> )<br/>(princ)<br/>) 9年前的讨论就这么高的质量，佩服 谢谢<strong><font face="Verdana" color="#61b713">xshrimp</font></strong>！！原来就差一句，我弄了很久都没弄出来，函数认识太少了。 本帖最后由 作者 于 2009-3-2 8:26:34 编辑
可不可以改成这样? 可以把它改成文字由列表选择或者键盘输入吗？ hstea发表于2009-3-2 14:39:00static/image/common/back.gif可以把它改成文字由列表选择或者键盘输入吗？
<p>加上這個就可以键盘输入啦</p><p>(setq ssde (getstring "请输入文字: "))</p> 如我第四楼上所说的,如何可以自动标注圆弧半径呢? 这个程序好像在图纸空间不行哦,而且,想问下,如何定义文字的大小呢? userzhl发表于2009-3-17 0:22:00static/image/common/back.gif这个程序好像在图纸空间不行哦,而且,想问下,如何定义文字的大小呢?(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
改成:
;;By carrot1983
(defun CAI-SPACE (/ SPACE ACADDCC)
(setq ACADDCC (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq SPACE (vla-get-paperspace ACADDCC))
(setq SPACE (vla-get-modelspace ACADDCC))
)
SPACE
)
(CAI-SPACE)