马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 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]
|