寒潮大冬瓜 发表于 2024-9-9 21:42:22

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

lijunfa12345 发表于 2024-9-30 20:59:03

支持院长。。。。。

寒潮大冬瓜 发表于 2024-10-8 01:30:55

院长好!请教这个代码如何直接获取样条曲线拟合点的集合?
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-11 08:13:57

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

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

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

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

寒潮大冬瓜 发表于 2024-12-26 11:34:18

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


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

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

本帖最后由 xyp1964 于 2024-12-26 13:22 编辑

寒潮大冬瓜 发表于 2024-10-8 01:30
院长好!请教这个代码如何直接获取样条曲线拟合点的集合?
yshf发表于 2018-11-16 09:42:28 | 只看该作者
...
(defun GetFitPoints (s1)
"样条曲线拟合点"
(mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 11)) (entget s1)))
)
(defun GetControlPoints (s1)
"样条曲线控制点"
(mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1)))
)

寒潮大冬瓜 发表于 2024-12-26 15:01:16

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


感谢院长指导!

寒潮大冬瓜 发表于 2024-12-30 00:15:38

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

624777395 发表于 2025-1-24 09:18:45

xyp-TuPtn    xyp-AoPtn,院长能不能发一下这两个函数啊
页: 27 28 29 30 31 32 33 34 35 36 [37]
查看完整版本: 【e派】工具箱函数再揭秘及应用实例