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

xyp1964

1. ;; xyp-9Pt 实体或选择集9点坐标 (xyp-9Pt ename site)
   
2. (defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8 i p1a p9a s1 x ob mid)
   
3.   (defun mid (p1 p2)
   
4.     (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))
   
5.   )
   
6.   (cond ((= (type ename) 'ENAME)
   
7.          (vla-getboundingbox (vlax-ename->vla-object ename) 'MinPT 'MaxPT)
   
8.          (setq p1 (vlax-safearray->list MinPT)
   
9.                p9 (vlax-safearray->list MaxPT)
   
10.          )
    
11.         )
    
12.         ((= (type ename) 'VLA-OBJECT)
    
13.          (vla-getboundingbox ename 'MinPT 'MaxPT)
    
14.          (setq p1 (vlax-safearray->list MinPT)
    
15.                p9 (vlax-safearray->list MaxPT)
    
16.          )
    
17.         )
    
18.         ((= (type ename) 'PICKSET)
    
19.          (setq i   -1
    
20.                p1a '()
    
21.                p9a '()
    
22.          )
    
23.          (while  (setq s1 (ssname ename (setq i (1+ i))))
    
24.            (setq ob (vlax-ename->vla-object s1))
    
25.            (vla-getboundingbox ob 'MinPT 'MaxPT)
    
26.            (setq p1  (vlax-safearray->list MinPT)
    
27.                  p9  (vlax-safearray->list MaxPT)
    
28.                  p1a (cons p1 p1a)
    
29.                  p9a (cons p9 p9a)
    
30.            )
    
31.          )
    
32.          (setq p1 (apply 'mapcar (cons 'min p1a))
    
33.                p9 (apply 'mapcar (cons 'max p9a))
    
34.          )
    
35.         )
    
36.   )
    
37.   (setq p5 (mid p1 p9)
    
38.         p3 (if (< (car p9) (car p1))
    
39.              (list (car p1) (cadr p9) (caddr p1))
    
40.              (list (car p9) (cadr p1) (caddr p1))
    
41.            )
    
42.         p7 (if (< (car p9) (car p1))
    
43.              (list (car p9) (cadr p1) (caddr p9))
    
44.              (list (car p1) (cadr p9) (caddr p9))
    
45.            )
    
46.         p2 (mid p1 p3)
    
47.         p4 (mid p1 p7)
    
48.         p6 (mid p3 p9)
    
49.         p8 (mid p7 p9)
    
50.   )
    
51.   (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
    
52. )

;; xyp-9Pt 实体或选择集9点坐标 (xyp-9Pt ename site)<br /> (defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8 i p1a p9a s1 x ob mid)<br />   (defun mid (p1 p2)<br />     (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))<br />   )<br />   (cond ((= (type ename) 'ENAME)<br />          (vla-getboundingbox (vlax-ename->vla-object ename) 'MinPT 'MaxPT)<br />          (setq p1 (vlax-safearray->list MinPT)<br />                p9 (vlax-safearray->list MaxPT)<br />          )<br />         )<br />         ((= (type ename) 'VLA-OBJECT)<br />          (vla-getboundingbox ename 'MinPT 'MaxPT)<br />          (setq p1 (vlax-safearray->list MinPT)<br />                p9 (vlax-safearray->list MaxPT)<br />          )<br />         )<br />         ((= (type ename) 'PICKSET)<br />          (setq i   -1<br />                p1a '()<br />                p9a '()<br />          )<br />          (while  (setq s1 (ssname ename (setq i (1+ i))))<br />            (setq ob (vlax-ename->vla-object s1))<br />            (vla-getboundingbox ob 'MinPT 'MaxPT)<br />            (setq p1  (vlax-safearray->list MinPT)<br />                  p9  (vlax-safearray->list MaxPT)<br />                  p1a (cons p1 p1a)<br />                  p9a (cons p9 p9a)<br />            )<br />          )<br />          (setq p1 (apply 'mapcar (cons 'min p1a)) <br />                p9 (apply 'mapcar (cons 'max p9a))<br />          )<br />         )<br />   )<br />   (setq p5 (mid p1 p9)<br />         p3 (if (< (car p9) (car p1))<br />              (list (car p1) (cadr p9) (caddr p1))<br />              (list (car p9) (cadr p1) (caddr p1))<br />            )<br />         p7 (if (< (car p9) (car p1))<br />              (list (car p9) (cadr p1) (caddr p9))<br />              (list (car p1) (cadr p9) (caddr p9))<br />            )<br />         p2 (mid p1 p3)<br />         p4 (mid p1 p7)<br />         p6 (mid p3 p9)<br />         p8 (mid p7 p9)<br />   )<br />   (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))<br /> )

寒潮大冬瓜

院长更新了这个9点自定义函数增加了‘选择集’功能

lijunfa12345

支持院长。。。。。

寒潮大冬瓜

院长好！请教这个代码如何直接获取样条曲线拟合点的集合？
yshf发表于 2018-11-16 09:42:28 | 只看该作者
;样条曲线按拟合点转二维多段线
(defun c:test()
     (vl-load-com)
     (setq AcadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (vla-StartUndoMark AcadDoc)
     (if (setq ssa (ssget '((0 . "Spline"))))
         (progn
             (vlax-for obj (vla-get-ActiveSelectionSet AcadDoc)
                 (setq ptb (vlax-get-property obj "FitPoints"))
                 (setq plobj (vla-AddPolyline (vla-get-ModelSpace AcadDoc) ptb))
                 (vlax-put plobj "color" 1)
                 ;(vla-delete obj) ;;要删除原样条曲线取消此行注释
             )
            
         )
     )
     (vla-EndUndoMark AcadDoc)
     (vlax-release-object AcadDoc)
     (princ)
)

寒潮大冬瓜

寒潮大冬瓜 发表于 2024-10-8 01:30
院长好！请教这个代码如何直接获取样条曲线拟合点的集合？
yshf发表于 2018-11-16 09:42:28 | 只看该作者
...

(vla-get-ControlPoints obj) ;取得样条曲线的控制点
(vla-get-fitpoints obj);获得样条曲线拟合点坐标