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

寒潮大冬瓜

院长更新了这个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);获得样条曲线拟合点坐标

xyp1964

1. (defun xyp-count1 (lst / aa b1 lst1 lst2)
   
2.   "xyp-count1 以子表第一个元素统计 (xyp-count1 lst表)"
   
3.   (while lst
   
4.     (setq aa   (car lst)
   
5.           bb   (car aa)
   
6.           lst  (cdr lst)
   
7.           lst1 (vl-remove-if-not '(lambda (x) (equal (car x) bb)) lst)
   
8.           lst  (vl-remove-if '(lambda (x) (equal (car x) bb)) lst)
   
9.           lst1 (mapcar 'cdr (cons aa lst1))
   
10.           lst2 (cons (cons bb lst1) lst2)
    
11.     )
    
12.   )
    
13.   (reverse lst2)
    
14. )

(defun xyp-count1 (lst / aa b1 lst1 lst2)<br />   "xyp-count1 以子表第一个元素统计 (xyp-count1 lst表)"<br />   (while lst<br />     (setq aa   (car lst)<br />           bb   (car aa)<br />           lst  (cdr lst)<br />           lst1 (vl-remove-if-not '(lambda (x) (equal (car x) bb)) lst)<br />           lst  (vl-remove-if '(lambda (x) (equal (car x) bb)) lst)<br />           lst1 (mapcar 'cdr (cons aa lst1))<br />           lst2 (cons (cons bb lst1) lst2)<br />     )<br />   )<br />   (reverse lst2)<br /> )

寒潮大冬瓜

xyp1964 发表于 2024-12-19 11:16

感谢院长分享！抽时间好好学习！

xyp1964

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

1. (defun GetFitPoints (s1)
   
2.   "样条曲线拟合点"
   
3.   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 11)) (entget s1)))
   
4. )
   
5. (defun GetControlPoints (s1)
   
6.   "样条曲线控制点"
   
7.   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1)))
   
8. )

(defun GetFitPoints (s1)<br />   "样条曲线拟合点"<br />   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 11)) (entget s1)))<br /> )<br /> (defun GetControlPoints (s1)<br />   "样条曲线控制点"<br />   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1)))<br /> )

寒潮大冬瓜

xyp1964 发表于 2024-12-26 13:17

感谢院长指导！

寒潮大冬瓜

院长好！辛苦指导……
(defun c:tt ()
  (command "3dpoly")
  (while (setq s1 (car (entsel "\n选择: ")))
    (command "non" (xyp-DXF 10 s1))
  )
  (command "")
  (princ)
)
类似这个三维多段线的点取图元获取坐标后继续画线的pline和line线，如何能顺利实现?

624777395

xyp-TuPtn    xyp-AoPtn，院长能不能发一下这两个函数啊