[求助]动态引线的箭头方向怎么判断？（已解决）

jh1005

 想弄一个引线会跟着鼠标移动走的，用来做局部放大用，但当鼠标移到对象的另一边时，引线就反了，请问怎样可以把左边那个改成像右边那个一样？有劳诸位大侠，谢谢！！

还有，鼠标的十字线能不能暂时隐藏掉？

xshrimp

增加一句就可以了.
(vla-put-VerticalTextPosition Leader 1)

3. (defun c:test (/ ent mspace i m wenzi a b c d aa bb cc dd ee ff gg leader)
4. (setq ent (car (entsel)))  ;;选择对象
5. (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
6. (setq i T)
7. (while i
8.   (setq a (grread T 4 0) b (car a) c (cadr a))        ;;b=5移动，b=3左键,c=0右键,;;c=13回车,c=32空格
9.   (cond ((= b 5)                                      ;当鼠标移动时            
10.         (setq a (trans (cadr a) 1 0))                 ;;鼠标移动点
11.         (setq d (vlax-curve-getclosestpointto ent a)) ;;a到对象ent的最近点
12.         (setq aa (car a) bb (cadr a) cc (caddr a))    ;;提取 a 的x,y,z
13.         (setq dd (car d) ee (cadr d) ff (caddr d))    ;;提取 d 的x,y,z
14.         ;;★创建引线★
15.         (setq gg (vlax-make-safearray vlax-vbDouble '(0 . 5)))
16.         (vlax-safearray-fill gg (list dd ee ff aa (- (cadr a) 2) cc))  ;;填满gg
17.      (if (not Leader)  ;;如果leader为空
18.          (progn
19.          (setq m (vla-AddMText mspace (vlax-3d-point (list aa (- (cadr a) 1.5))) 0 "A")) ;;创建文字A
20.          (setq wenzi (vlax-make-safearray vlax-vbString '(1 . 9)))
21.          (vlax-safearray-fill wenzi '("TopLeft" "TopCenter" "TopRight" "MiddleLeft"
22.          "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")) ;;填满wenzi
23.          (setq Leader (vla-AddLeader mspace gg m acLineWithArrow))  ;;创建有箭头的引线
24.          ) ;;end_progn
25.        );;end_if
26.     (if (<= aa dd) ;;如果鼠标移动点的x坐标值小于等于最近点的X坐标值
27.         (vla-put-AttachmentPoint m 9)     ;;更改文字的贴附点为9（右下角）
28.         (vla-put-AttachmentPoint m 7)     ;;更改文字的贴附点为7（左下角）
29.     );;end_if
30. (vla-put-InsertionPoint m (vlax-3d-point (list aa (- (cadr a) 1.5))))  ;;更新文字插入点
31. (vla-put-Coordinates Leader gg)   ;;更新引线插入点
32. (vla-put-VerticalTextPosition Leader 1)
34. ) ;;end_cond第一个括号
35. ((= b 3) (setq i nil)) ;;左键结束while（cond第二个括号）
36. ) ;;end_cond
37. ) ;;end_while
38. (princ)
39. )

(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) )

jh1005

userzhl发表于2009-3-1 21:45:00可不可以改成这样?

(defun C:as ()         ;;水平--垂直标注互换                                              
(Setvar "CMDECHO" 0)
(if (and (= (getvar "dimtoh") 0) (= (getvar "dimtih") 0))
    (progn
    (Setvar "dimtoh" 1)
     (Setvar "dimtih" 1)
  (prompt "\n水平标注")
 )
 (progn
    (Setvar "dimtoh" 0)
     (Setvar "dimtih" 0)
  (prompt  "\n与尺寸线对齐")
 )
 )
(princ)
)

leon904828888

9年前的讨论就这么高的质量，佩服

jh1005

谢谢xshrimp！！原来就差一句，我弄了很久都没弄出来，函数认识太少了。

userzhl

可不可以改成这样?

hstea

可以把它改成文字由列表选择或者键盘输入吗？

samshs

hstea发表于2009-3-2 14:39:00可以把它改成文字由列表选择或者键盘输入吗？

加上這個就可以键盘输入啦

(setq ssde (getstring "请输入文字: "))

userzhl

如我第四楼上所说的,如何可以自动标注圆弧半径呢?

userzhl

这个程序好像在图纸空间不行哦,而且,想问下,如何定义文字的大小呢?

carrot1983

userzhl发表于2009-3-17 0:22:00这个程序好像在图纸空间不行哦,而且,想问下,如何定义文字的大小呢?

(setq mspace (vla-get-modelspace    (vla-get-activedocument    (vlax-get-acad-object))))
改成:

3. ;;By carrot1983
4. (defun CAI-SPACE (/ SPACE ACADDCC)
5.   (setq ACADDCC (vla-get-activedocument
6.     (vlax-get-acad-object)
7.   )
8.   )
9.   (if (and
10. (= (getvar "tilemode") 0)
11. (= (getvar "cvport") 1)
12.       )
13.     (setq SPACE (vla-get-paperspace ACADDCC))
14.     (setq SPACE (vla-get-modelspace ACADDCC))
15.   )
16.   SPACE
17. )

;;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)