明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1307|回复: 1

代码修改(求助)

[复制链接]
发表于 2012-9-27 18:00:40 | 显示全部楼层 |阅读模式
下列代码是箭头大小控制引线的比例,我想箭头大小为1,由全局比例控制引线的比例,如何实现,请大师帮忙。
(defun dt-Leader          ;动态引线
;对象/点 文字 颜色 图层 样式 字高
(ent str col lay sty gao / mspace i wenzi a b c d aa bb cc dd ee ff gg Leader m)
(if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
  (setq mspace (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
)
(setq i T)
(while i
(setq a (grread T 12 1) 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))                  ;鼠标移动点
(cond
  ((= (type ent) 'LIST) (setq d ent)) ;固定点
  ((= (type ent) 'ENAME) (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)
   (progn
     (setq m (vla-AddMText mspace (vlax-3d-point (list aa bb)) 0 str)) ;创建文字
        (if col (vla-put-color m col))
        (if lay (vla-put-layer m lay))
        (if sty (vla-put-StyleName m sty))
        (if gao (vla-put-height m gao))
     (setq wenzi (vlax-make-safearray vlax-vbString '(1 . 9)))  ;建立字符表
     (vlax-safearray-fill wenzi '("TopLeft" "TopCenter" "TopRight" "MiddleLeft"
     "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")) ;填满wenzi
     (vla-put-attachmentpoint m 7)     ;更新文字的贴附点为7
     (setq Leader (vla-AddLeader mspace gg m acLineWithArrow)) ;有箭头的线
        (if col (vla-put-color Leader col))
        (if lay (vla-put-layer Leader lay))
        (if gao (vla-put-arrowheadsize Leader gao))
   )
)
(vla-put-insertionpoint m (vlax-3d-point (list aa (- (cadr a) 1.5)))) ;更新文字插入点
(vla-put-coordinates Leader gg)         ;更新引线插入点
(vla-put-verticaltextposition Leader 1) ;引线自动判断方向
)
((= b 3) (setq i nil)) ;左键结束while
) ;end_cond
) ;end_while
(princ)
)



该贴已经同步到 tanle2020的微博
 楼主| 发表于 2013-9-26 10:28:47 | 显示全部楼层
这段动态引线代码为文字在引线上方,怎样改为文字在引线的后面?求指点
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-26 07:20 , Processed in 0.155874 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表