选择曲线和点实体拟合生成椭圆

Lispboy · 发表于 2017-1-12 14:17:44

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lispboy 于 2017-1-12 14:47 编辑

插件需要运行XDRX API 2017.01.12以上版本下。

[sell]

(defun c:XDTB_FITELLIPSE( / e key msg my_err pts pts1 ss ss1 va x)
   (defun my_err(msg)
     (princ (strcat "\n" msg))
     (setq *error* nil)
     (xdrx_end)
   )
   (xdrx_begin)
   (defun _keyword(key)
     (cond
       ((= key "E")
         (xdrx_initget "Y N")
         (setq va (xdrx_yesorno "\n>>>是否删除选择集" 1))
         (if (= va 1)
           (setq #fitellpse_mode "Yes")
           (setq #fitellpse_mode "No")
         )         
       )
     )
     (xdrx_initget "E")
     (_prompt)
   )
   (defun _prompt ()
      (xdrx_prompt "\n当前设置:删除原选择集(" #fitellpse_mode ")")
   )
   (if (not #fitellpse_mode)
     (setq #fitellpse_mode "Yes")
   )
   (setq *error* my_err)
   (_prompt)
   (xdrx_initget "E")
   (xdrx_initssget "\n选取要转椭圆的曲线，点[设置(E)]<退出>:" "E" "" "_keyword" "")
   (if (setq ss (xdrx_ssget '((0 . "POINT,*POLYLINE,LINE,ARC,SPLINE,ELLIPSE"))))
     (progn
       (setq pts (apply 'append (mapcar '(lambda(x)(xdrx_getsamplept x))(xdrx_pickset->ents ss)))
             ss1 (xd::pickset:getsub ss '((0 . "POINT")))             
             pts1 (mapcar '(lambda(x)(xdrx_getpropertyvalue x "position")) (xdrx_pickset->ents ss1))
             pts (append pts pts1)
       )
       (setq e (xdrx_points_fitellipse pts t))
       (if (= #fitellpse_mode "Yes")
         (xdrx_entity_delete ss)
       )
     )
   )
   (setq *error* nil)
   (xdrx_end)
   (princ)
)

[/sell]

qqqincccken · 发表于 2017-2-3 00:08:39

谢谢提供，有机会学习学习

yoyoho · 发表于 2017-2-4 15:23:39

感谢 Lispboy 分享程序!!!!

alliuyx · 发表于 2017-2-16 07:16:46

正需要，支持楼主大人了！

alliuyx · 发表于 2017-2-20 08:09:12

正需要，支持楼主大人了！

zhangq_cai1 · 发表于 2017-2-20 08:19:06

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

账号		自动登录	找回密码
密码			立即注册

[曲线] 选择曲线和点实体拟合生成椭圆

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。