更新 Leader 引线

eachy · 发表于 2014-7-4 11:32:28

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

昨天炫翔版主谈到修改 Leader 引线样式，就写了一个示例，Xdrxapi 对这个Leader的 SetVertexAt 函数有 Bug，借用了 Free-lancer 的几个函数

(defun c:tt (/ ss)
(fy:begin)
(if (ssget '((0 . "LEADER")))
(mapcar '(lambda (x / mtxt bp up an spa pts p0 p1 p2 p3 zh)
(setq mtxt (vla-get-annotation x)) ;_关联文字
(vla-getboundingbox mtxt 'bp 'up)
(setq bp (safearray-value bp)
up (safearray-value up)
p0 (list (car bp) (cadr up) 0.) ;_文字BOX左上交点
an (vla-get-rotation mtxt)
zh (vla-get-height mtxt) ;_字高
spa (* 0.5
(- (vla-get-LineSpacingDistance mtxt)
zh
)
) ;_行间距一半
pts (vlax-get x 'Coordinates) ;_引线坐标点
p1 (mapcar '+
p0
(list (- (/ zh 2.5))
(- (+ spa
(vla-get-height mtxt)
)
)
0.
)
) ;_引线第二点
p2 (list (car pts) (cadr pts) 0.) ;_引线指向点
p3 (mapcar '+
p1
(list (+ (/ zh 2.5) (- (car up) (car bp))) 0. 0.) ;_引线末端点
)
pts (list p2 p1 p3)
)
(vlax-put x 'Coordinates (apply 'append pts)) ;_更新引线
)
(fy:cset->objs)
)
)
(fy:end)
(princ)
)

(defun c:tt (/ ss) 
  (fy:begin) 
  (if (ssget '((0 . "LEADER"))) 
    (mapcar '(lambda (x / mtxt bp up an spa pts p0 p1 p2 p3 zh) 
               (setq mtxt (vla-get-annotation x)) ;_关联文字 
               (vla-getboundingbox mtxt 'bp 'up) 
               (setq bp         (safearray-value bp) 
                     up         (safearray-value up) 
                     p0         (list (car bp) (cadr up) 0.) ;_文字BOX左上交点 
                     an         (vla-get-rotation mtxt) 
                     zh         (vla-get-height mtxt) ;_字高 
                     spa (* 0.5 
                            (- (vla-get-LineSpacingDistance mtxt) 
                               zh 
                            ) 
                         ) ;_行间距一半 
                     pts (vlax-get x 'Coordinates) ;_引线坐标点 
                     p1         (mapcar '+ 
                                 p0 
                                 (list (- (/ zh 2.5)) 
                                       (- (+ spa 
                                             (vla-get-height mtxt) 
                                          ) 
                                       ) 
                                       0. 
                                 ) 
                         ) ;_引线第二点 
                     p2         (list (car pts) (cadr pts) 0.) ;_引线指向点 
                     p3         (mapcar '+ 
                                 p1 
                                 (list (+ (/ zh 2.5) (- (car up) (car bp))) 0. 0.) ;_引线末端点 
                         ) 
                     pts (list p2 p1 p3) 
               ) 
               (vlax-put x 'Coordinates (apply 'append pts)) ;_更新引线 
             ) 
            (fy:cset->objs) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

xiagood · 发表于 2014-7-4 12:04:49

不错啊，支持..........

XDSoft · 发表于 2014-7-4 13:01:35

SetVertexAt的BUG是什么，到API论坛发个帖子备注下吧。

/db_自贡黄明儒_ · 发表于 2014-7-4 13:21:36

本帖最后由 /db_自贡黄明儒_ 于 2015-2-12 10:21 编辑

这个要顶，向楼主学习不过，文本与引线要关联，处理过后不再关联，如何是好？

csharp · 发表于 2014-7-4 15:28:37

可以用 GetStretchPoint + MoveStretchPoint 组合

Michael527 · 发表于 2015-2-11 17:38:28

fy是什么函数呢？

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

[原创] 更新 Leader 引线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分