MLEADER 创建

czcxxx_01 · 发表于 2015-9-16 08:50:24

多重引线标坐标真的方便....

czcxxx_01 · 发表于 2015-9-16 08:50:51

很好，哈哈{:soso_e160:}{:soso_e163:}

bluelisp · 发表于 2016-4-15 10:02:11

学学！第一次摸 MLEADER

zjy2999 · 发表于 2016-4-18 09:43:41

学习！！！！！！！！

zeng7659 · 发表于 2016-4-18 16:42:38

这个功能的确是比较食用

newer · 发表于 2016-4-21 19:25:36

HORSE_XU 发表于 2014-12-25 09:53
这个功能的确是比较食用

帮修改了下代码，支持UCS，左右拖动时候文字都左对齐，这样适合坐标标注那些应用了。

(defun _AddMleader (p1 p2 str)
(setq ml (vlax-invoke
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
'AddMleader
(append p1 p2)
0
)
)
(vla-put-DoglegLength ml 0.0)
(vla-put-textleftattachmenttype ml 3)
(vla-put-textrightattachmenttype ml 3)
(vla-put-textstring ml str)
(vla-put-LandingGap ml 0.0)
(vla-put-TextLineSpacingFactor ml 0.8)
(vla-put-TextLineSpacingStyle ml 1)
(vla-put-TextJustify ml 1)
(vla-put-DogLegged ml -1)
(vla-put-ContentType ml 2)
(vla-put-textrotation ml 0.0)
)
(defun c:tt (/ p e p1)
(defun callback (dynpt /)
(xdrx_entity_movestretchpoint e (mapcar '- dynpt p) 0 1 2)
(setq ml (vlax-ename->vla-object e))
(vla-put-TextJustify ml 1)
(setq p dynpt)
)
(if (setq p (getpoint "\nPoint: "))
(progn (setq p (trans p 1 0))
(_addmleader
p
(polar p 0.0 1.0)
"THIS IS A MLEADER TEST\\PTHE SECOND LINE"
)
(setq e (entlast))
(xdrx_pointmonitor "callback")
(getpoint "\nPosition: ")
)
)
(xdrx_pointmonitor)
(princ)
)

(defun _AddMleader (p1 p2 str) 
  (setq        ml (vlax-invoke 
             (vla-get-modelspace 
               (vla-get-activedocument (vlax-get-acad-object)) 
             ) 
             'AddMleader 
             (append p1 p2) 
             0 
           ) 
  ) 
  (vla-put-DoglegLength ml 0.0) 
  (vla-put-textleftattachmenttype ml 3) 
  (vla-put-textrightattachmenttype ml 3) 
  (vla-put-textstring ml str) 
  (vla-put-LandingGap ml 0.0) 
  (vla-put-TextLineSpacingFactor ml 0.8) 
  (vla-put-TextLineSpacingStyle ml 1) 
  (vla-put-TextJustify ml 1) 
  (vla-put-DogLegged ml -1) 
  (vla-put-ContentType ml 2) 
  (vla-put-textrotation ml 0.0) 
) 
(defun c:tt (/ p e p1) 
  (defun callback (dynpt /) 
    (xdrx_entity_movestretchpoint e (mapcar '- dynpt p) 0 1 2) 
    (setq ml (vlax-ename->vla-object e)) 
    (vla-put-TextJustify ml 1) 
    (setq p dynpt) 
  ) 
  (if (setq p (getpoint "\nPoint: ")) 
    (progn (setq p (trans p 1 0)) 
           (_addmleader 
             p 
             (polar p 0.0 1.0) 
             "THIS IS A MLEADER TEST\\PTHE SECOND LINE" 
           ) 
           (setq e (entlast)) 
           (xdrx_pointmonitor "callback") 
           (getpoint "\nPosition: ") 
    ) 
  ) 
  (xdrx_pointmonitor) 
  (princ) 
)

eachy · 发表于 2016-4-21 19:46:52

newer 发表于 2016-4-21 19:25
帮修改了下代码，支持UCS，左右拖动时候文字都左对齐，这样适合坐标标注那些应用了。

ActiveX是深度包装，有些可能ARX公开资料不一定有

newer · 发表于 2016-4-21 23:07:31

本帖最后由 newer 于 2016-4-21 23:09 编辑

eachy 发表于 2016-4-21 19:46
ActiveX是深度包装，有些可能ARX公开资料不一定有

又完善了下代码，取标注坐标为例子，点监视器循环里面不适用MoveStretchPoint，改直接修改mleader的第二点和DogLegDirection方向，判断了上下左右情况，这样拖动更完美了。录像3_转.gif

(defun _AddMleader (p1 p2 str)
(setq ml (vlax-invoke
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
'AddMleader
(append p1 p2)
0
)
)
(vla-put-DoglegLength ml 5.0)
(vla-put-textleftattachmenttype ml 7)
(vla-put-textrightattachmenttype ml 7)
(vla-put-textstring ml str)
(vla-put-LandingGap ml 0.0)
(vla-put-TextLineSpacingFactor ml 0.8)
(vla-put-TextLineSpacingStyle ml 2)
(vla-put-TextJustify ml 1)
(vla-put-DogLegged ml -1)
(vla-put-ContentType ml 2)
(vla-put-textrotation ml 0.0)
)
(defun c:tt (/ p e p1)
(defun callback (dynpt /)
(setq direc 1.0)
(if (< (xdrx_vector_dotproduct (mapcar '- dynpt firstPnt) xdir) 0.0)
(setq direc -1.0)
)
(setq dogdirect (xdrx_vector_product xdir direc))
(xdrx_setpropertyvalue e "lastvertex" (list 0 dynpt) "doglegdirection" (list 0 dogdirect) "TextAlignmentType" (list 0 1) "leaderlinetype" (list 0 1) )
(setq p dynpt)
)
(if (setq p (getpoint "\nPoint: "))
(progn
(setq p1 (trans p 1 0) x (cadr p1) y (car p1))
(_addmleader
p1
(polar p1 0.0 1.0)
(strcat "X=" (rtos x 2 2) "\\P" "Y=" (rtos y 2 2))
)
(setq e (entlast))
(setq firstPnt (xdrx_getpropertyvalue e "firstVertex" 0))
(setq xdir (getvar "ucsxdir"))
(xdrx_pointmonitor "callback")
(getpoint "\nPosition: ")
)
)
(xdrx_pointmonitor)
(princ)
)

(defun _AddMleader (p1 p2 str) 
(setq    ml (vlax-invoke 
     (vla-get-modelspace 
     (vla-get-activedocument (vlax-get-acad-object)) 
     ) 
     'AddMleader 
     (append p1 p2) 
     0 
     ) 
) 
(vla-put-DoglegLength ml 5.0) 
(vla-put-textleftattachmenttype ml 7) 
(vla-put-textrightattachmenttype ml 7) 
(vla-put-textstring ml str) 
(vla-put-LandingGap ml 0.0) 
(vla-put-TextLineSpacingFactor ml 0.8) 
(vla-put-TextLineSpacingStyle ml 2) 
(vla-put-TextJustify ml 1) 
(vla-put-DogLegged ml -1) 
(vla-put-ContentType ml 2) 
(vla-put-textrotation ml 0.0) 
) 
(defun c:tt (/ p e p1) 
(defun callback (dynpt /) 
  (setq direc 1.0) 
  (if (< (xdrx_vector_dotproduct (mapcar '- dynpt firstPnt) xdir) 0.0) 
    (setq direc -1.0) 
  ) 
  (setq dogdirect (xdrx_vector_product xdir direc)) 
  (xdrx_setpropertyvalue e "lastvertex" (list 0 dynpt) "doglegdirection" (list 0 dogdirect) "TextAlignmentType" (list 0 1) "leaderlinetype" (list 0 1) ) 
  (setq p dynpt)   
) 
(if (setq p (getpoint "\nPoint: ")) 
  (progn 
    (setq p1 (trans p 1 0) x (cadr p1) y (car p1)) 
     (_addmleader 
     p1 
     (polar p1 0.0 1.0) 
     (strcat "X=" (rtos x 2 2) "\\P" "Y=" (rtos y 2 2)) 
     ) 
     (setq e (entlast)) 
     (setq firstPnt (xdrx_getpropertyvalue e "firstVertex" 0)) 
     (setq xdir (getvar "ucsxdir")) 
     (xdrx_pointmonitor "callback") 
     (getpoint "\nPosition: ") 
  ) 
) 
(xdrx_pointmonitor) 
(princ) 
)

nothing3443 · 发表于 2016-5-6 13:34:04

回复可见~:lol:lol:lol:lol

lucas3 · 发表于 2016-5-6 14:08:24

看看学习一下

kuotze · 发表于 2016-12-20 00:30:27

woo good work

lijiao · 发表于 2016-12-20 09:25:15

xuexixuexi

xzs16 · 发表于 2016-12-20 09:46:44

我来测试一下，行不行

石楠花 · 发表于 2016-12-21 16:06:43

看看学习学习~~~~

原地踏步 · 发表于 2017-5-30 13:23:37

楼主强大。学习了。

账号		自动登录	找回密码
密码			立即注册

[每日一码] MLEADER 创建

点评

点评