马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
x
本帖最后由 newer 于 2018-10-22 12:35 编辑
 - (defun c:xdtb_shortln2pnt (/ ss i x #length #midpoint oldpdmode oldpdsize)
- (defun *error* (msg)
- (princ msg)
- (if oldpdmode
- (setvar "pdmode" oldpdmode)
- )
- (mapcar '(lambda (x) (xdrx_object_regen x)) pts)
- (xdrx_end)
- )
- (defun _callback (dynpt)
- (mapcar '(lambda (x) (xdrx_object_regen x)) pts)
- (princ)
- )
- (xdrx_begin)
- (setq oldpdmode (getvar "pdmode")
- oldsize (getvar "pdsize")
- )
- (if (not #xd_var_global_shortlen)
- (setq #xd_var_global_shortlen 0.01)
- )
- (if (setq val (getreal (xdrx_prompt
- "\n输入短线精度<"
- #xd_var_global_shortlen
- ">:"
- t
- )
- )
- )
- (setq #xd_var_global_shortlen val)
- )
- (if (and (xdrx_initssget "\n选择要处理的曲线<退出>:")
- (setq ss (xdrx_ssget '((0 . "*line,arc,ellipse,circle"))))
- )
- (progn (setq i 0)
- (mapcar '(lambda (x)
- (if (equal (xdrx_getpropertyvalue x "length")
- 0.0
- #xd_var_global_shortlen
- )
- (progn (xdrx_point_make (xdrx_getpropertyvalue x "midpoint"))
- (setq pts (cons (entlast) pts))
- (xdrx_entity_setpropertiesfrom (entlast) x)
- (setq i (1+ i))
- (xdrx_entity_delete x)
- )
- )
- )
- (xdrx_pickset->ents ss)
- )
- (xdrx_initget "F")
- (while (setq pt (getpoint (xdrx_prompt
- "\n处理了"
- i
- "条曲线,转换成点.[查看(F)]<退出>:"
- t
- )
- )
- )
- (progn (cond ((= pt "F")
- (xdrx_setvar "pdmode" 35)
- (xdrx_setvar "pdsize" 0)
- (xdrx_pointmonitor "_callback")
- )
- )
- )
- )
- (xdrx_pointmonitor)
- )
- )
- (xdrx_setvar "pdmode" oldpdmode)
- (mapcar '(lambda (x) (xdrx_object_regen x)) pts)
- (xdrx_end)
- (princ)
- )
|