【e派】工具箱函数再揭秘及应用实例

xyp1964

1. ;; xyp-ScaleEntity 缩放实体或选择集 (xyp-ScaleEntity ename point sc)
   
2. (defun xyp-ScaleEntity (ename point sc / tp pt i s1 x)
   
3.   (setq tp (type ename)
   
4. pt (vlax-3D-point (trans point 1 0))
   
5.   )
   
6.   (cond ((= tp 'ENAME) (vla-scaleentity (xyp-e2o ename) pt sc))
   
7. ((= tp 'PICKSET)
   
8.     (setq i -1)
   
9.     (while (setq s1 (ssname ename (setq i (1+ i))))
   
10.       (vla-scaleentity (xyp-e2o s1) pt sc)
    
11.     )
    
12.   )
    
13. ((= tp 'LIST) (foreach x (xyp-ScaleEntity x point sc)))
    
14.   )
    
15.   ename
    
16. )
    
17. 
    
18. ;; 应用实例2: 柱子缩放
    
19. (defun c:tt2 ()
    
20.   (CMDLA0)
    
21.   (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "柱")))
    
22. l1 '((0 . "Line") (8 . "轴线"))
    
23. l2 '((0 . "DIMENSION") (8 . "COLUMN-平法定位"))
    
24. i  -1
    
25.   )
    
26.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
27.     (setq p1 (xyp-get-9pt s1 1)
    
28.    p1 (xyp-get-Pt2XY p1 -200 -200)
    
29.    p9 (xyp-get-9pt s1 9)
    
30.    p9 (xyp-get-Pt2XY p9 200 200)
    
31.     )
    
32.     (if (and (setq ss1 (ssget "c" p1 p9 l1))
    
33.       (= (sslength ss1) 2)
    
34. )
    
35.       (progn
    
36. (setq s2  (ssname ss1 0)
    
37.        s3  (ssname ss1 1)
    
38.        pt  (car (xyp-get-Inters s2 s3 0))
    
39.        ss2 (ssget "c" p1 p9 l2)
    
40.        ss2(ssadd s1 ss2)
    
41. )
    
42. (xyp-ScaleEntity ss2 pt 0.5)
    
43. (command"dim" "upd" ss2 "" "e")
    
44.       )
    
45.     )
    
46.   )
    
47.   (CMDLA1)
    
48. )
    

;; xyp-ScaleEntity 缩放实体或选择集 (xyp-ScaleEntity ename point sc)<br /> (defun xyp-ScaleEntity (ename point sc / tp pt i s1 x)<br />   (setq tp (type ename)<br /> pt (vlax-3D-point (trans point 1 0))<br />   )<br />   (cond ((= tp 'ENAME) (vla-scaleentity (xyp-e2o ename) pt sc))<br /> ((= tp 'PICKSET)<br />     (setq i -1)<br />     (while (setq s1 (ssname ename (setq i (1+ i))))<br />       (vla-scaleentity (xyp-e2o s1) pt sc)<br />     )<br />   )<br /> ((= tp 'LIST) (foreach x (xyp-ScaleEntity x point sc)))<br />   )<br />   ename<br /> )<br /> <br /> ;; 应用实例2: 柱子缩放<br /> (defun c:tt2 ()<br />   (CMDLA0)<br />   (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "柱")))<br /> l1 '((0 . "Line") (8 . "轴线"))<br /> l2 '((0 . "DIMENSION") (8 . "COLUMN-平法定位"))<br /> i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq p1 (xyp-get-9pt s1 1)<br />    p1 (xyp-get-Pt2XY p1 -200 -200)<br />    p9 (xyp-get-9pt s1 9)<br />    p9 (xyp-get-Pt2XY p9 200 200)<br />     )<br />     (if (and (setq ss1 (ssget "c" p1 p9 l1))<br />       (= (sslength ss1) 2)<br /> )<br />       (progn<br /> (setq s2  (ssname ss1 0)<br />        s3  (ssname ss1 1)<br />        pt  (car (xyp-get-Inters s2 s3 0))<br />        ss2 (ssget "c" p1 p9 l2)<br />        ss2(ssadd s1 ss2)<br /> )<br /> (xyp-ScaleEntity ss2 pt 0.5)<br /> (command"dim" "upd" ss2 "" "e")<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )<br />

随梦而飞

十分强大，太好了，作用巨大

xyp1964

柱子缩放扩展

xiaxiang

再次坐享其成,感谢院长坚持不懈的分享

xyp1964

xiaxiang 发表于 2012-8-6 08:38
再次坐享其成,感谢院长坚持不懈的分享

把已经发布的代码完整地整理一下？

xiaxiang

xyp1964 发表于 2012-8-6 09:37
把已经发布的代码完整地整理一下？

除了伪代码以外

xyp1964

1. ;; xyp-CircleLineDim 圆轴线标注 (xyp-CircleLineDim s1 dx dy)
   
2. (defun xyp-CircleLineDim (s1 dx dy / p1 p9 p0 ss2 s2 s3 s4 p11 p22)
   
3.   (setq p1 (xyp-get-9pt s1 1)
   
4. p1 (xyp-get-Pt2XY p1 (- dx) (- dy))
   
5. p9 (xyp-get-9pt s1 9)
   
6. p9 (xyp-get-Pt2XY p9 dx dy)
   
7. p0 (xyp-get-dxf 10 s1)
   
8.   )
   
9.   (if (and (setq ss2 (ssget "c" p1 p9 '((0 . "line"))))
   
10.     (= (sslength ss2) 2)
    
11.       )
    
12.     (progn
    
13.       (setq s3 (ssname ss2 0)
    
14.      s4 (ssname ss2 1)
    
15.       )
    
16.       (if (xyp-get-Inters s3 s4 3)
    
17. (progn
    
18.    (setq p11 (xyp-PerpendicularFoot-Pt2Line p0 s3)
    
19.   p22 (xyp-PerpendicularFoot-Pt2Line p0 s4)
    
20.    )
    
21.    (if (> (distance p0 p11) 0)
    
22.      (xyp-Dim-Ali p0 p11 600)
    
23.    )
    
24.    (if (> (distance p0 p22) 0)
    
25.      (xyp-Dim-Ali p0 p22 600)
    
26.    )
    
27. )
    
28.       )
    
29.     )
    
30.   )
    
31. )

;; xyp-CircleLineDim 圆轴线标注 (xyp-CircleLineDim s1 dx dy)<br /> (defun xyp-CircleLineDim (s1 dx dy / p1 p9 p0 ss2 s2 s3 s4 p11 p22)<br />   (setq p1 (xyp-get-9pt s1 1)<br /> p1 (xyp-get-Pt2XY p1 (- dx) (- dy))<br /> p9 (xyp-get-9pt s1 9)<br /> p9 (xyp-get-Pt2XY p9 dx dy)<br /> p0 (xyp-get-dxf 10 s1)<br />   )<br />   (if (and (setq ss2 (ssget "c" p1 p9 '((0 . "line"))))<br />     (= (sslength ss2) 2)<br />       )<br />     (progn<br />       (setq s3 (ssname ss2 0)<br />      s4 (ssname ss2 1)<br />       )<br />       (if (xyp-get-Inters s3 s4 3)<br /> (progn<br />    (setq p11 (xyp-PerpendicularFoot-Pt2Line p0 s3)<br />   p22 (xyp-PerpendicularFoot-Pt2Line p0 s4)<br />    )<br />    (if (> (distance p0 p11) 0)<br />      (xyp-Dim-Ali p0 p11 600)<br />    )<br />    (if (> (distance p0 p22) 0)<br />      (xyp-Dim-Ali p0 p22 600)<br />    )<br /> )<br />       )<br />     )<br />   )<br /> )

;; 实例：圆轴标注

YYHappy1314

支持，顶~，好好学习

仲文玉

什么都不说，支持

xsso

继续收藏！