创建弧长标注

Lisphk

学习VLISP，写了个创建弧长标注的函数

参数
e: 可以是圆弧实体，也可以是圆心点
spt:圆弧标注起点
ept:圆弧标注终点
pos:标注线的位置点

1. (defun XD:DIM:MakeDimArc (e spt ept pos / cen)
   
2.   (if (= (type e) 'ename)
   
3.     (setq cen (vla-get-center (vlax-ename->vla-object e)))
   
4.     (setq cen (vlax-3d-point e))
   
5.   )
   
6.   (if (not
   
7.   (vl-catch-all-error-p
   
8.     (vl-catch-all-apply
   
9.       'vla-adddimarc
   
10.       (list (vla-get-modelspace
    
11.         (vla-get-activedocument (vlax-get-acad-object))
    
12.       )
    
13.       cen
    
14.       (vlax-3d-point spt)
    
15.       (vlax-3d-point ept)
    
16.       (vlax-3d-point pos)
    
17.       )
    
18.     )
    
19.   )
    
20.       )
    
21.     (entlast)
    
22.   )
    
23. )

(defun XD:DIM:MakeDimArc (e spt ept pos / cen)<br />   (if (= (type e) 'ename)<br />     (setq cen (vla-get-center (vlax-ename->vla-object e)))<br />     (setq cen (vlax-3d-point e))<br />   )<br />   (if (not<br />   (vl-catch-all-error-p<br />     (vl-catch-all-apply<br />       'vla-adddimarc<br />       (list (vla-get-modelspace<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />       cen<br />       (vlax-3d-point spt)<br />       (vlax-3d-point ept)<br />       (vlax-3d-point pos)<br />       )<br />     )<br />   )<br />       )<br />     (entlast)<br />   )<br /> )

newer

很不错，可用，建议， 起始点SPT和终点EPT 可以给参数T，直接标注弧的起点和端点，这样就省去函数外部另外计算端点的代码了。

cable2004

很不错，可用，建议！

Lisphk

newer 发表于 2016-10-3 22:36

修改了，现在SPT , EPT如果不给点，并且E是实体的时候，取整个弧标注了。

1. (defun XD:DIM:MakeDimArc (e spt ept pos / cen)
   
2.   (if (= (type e) 'ename)
   
3.     (progn
   
4.       (setq cen (vla-get-center (setq obj (vlax-ename->vla-object e))))
   
5.       (if (/= (type spt) 'LIST)
   
6.   (setq spt (vla-get-startpoint obj))
   
7.   (setq spt (vlax-3d-point spt))
   
8.       )
   
9.       (if (/= (type ept) 'LIST)
   
10.   (setq ept (vla-get-endpoint obj))
    
11.   (setq ept (vlax-3d-point ept))
    
12.       )
    
13.     )
    
14.     (setq cen (vlax-3d-point e))
    
15.   )
    
16.   (if (not (vl-catch-all-error-p
    
17.        (vl-catch-all-apply
    
18.          'vla-adddimarc
    
19.          (list
    
20.      (vla-get-modelspace
    
21.        (vla-get-activedocument
    
22.          (vlax-get-acad-object)
    
23.        )
    
24.      )
    
25.      cen
    
26.      spt
    
27.      ept
    
28.      (vlax-3d-point pos)
    
29.          )
    
30.        )
    
31.      )
    
32.       )
    
33.     (entlast)
    
34.   )
    
35. )
    

(defun XD:DIM:MakeDimArc (e spt ept pos / cen)<br />   (if (= (type e) 'ename)<br />     (progn<br />       (setq cen (vla-get-center (setq obj (vlax-ename->vla-object e))))<br />       (if (/= (type spt) 'LIST)<br />   (setq spt (vla-get-startpoint obj))<br />   (setq spt (vlax-3d-point spt))<br />       )<br />       (if (/= (type ept) 'LIST)<br />   (setq ept (vla-get-endpoint obj))<br />   (setq ept (vlax-3d-point ept))<br />       )<br />     )<br />     (setq cen (vlax-3d-point e))<br />   )<br />   (if (not (vl-catch-all-error-p<br />        (vl-catch-all-apply<br />          'vla-adddimarc<br />          (list<br />      (vla-get-modelspace<br />        (vla-get-activedocument<br />          (vlax-get-acad-object)<br />        )<br />      )<br />      cen<br />      spt<br />      ept<br />      (vlax-3d-point pos)<br />          )<br />        )<br />      )<br />       )<br />     (entlast)<br />   )<br /> )<br />

yoyoho

啥也不说了，感谢楼主分享哇！

ynhh

能不能标注椭圆弧啊？

newer

ynhh 发表于 2016-10-4 11:51

CAD有命令能标注椭圆弧吗？

不过，可以写个插件硬标了，你去 编程申请  发个帖子吧。

scnjlwb

谢谢分享！

du945862399

感谢分享，最近正需要这样的功能