马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 newer 于 2020-5-23 16:49 编辑
需要的函数见开源函数库论坛
(XD::Polyline:Remove-Half-Circle)删除带弧段多段线指定位置的半圆弧0 个回复 - 0 次查看
 - (defun c:xdtb_rhalfcir (/ e verts bulges m x y garc pmid)
- (xdrx-begin)
- (if (and (xdrx-initget "M")
- (setq e (xdrx-entsel
- "\n拾取跨线半圆[多选(M)]<退出>:"
- '((0 . "*polyline"))
- )
- )
- )
- (progn
- (cond ((= e "M")
- (if (and (xdrx-initssget "\n选择删除跨线的多段线<退出>:")
- (setq ss (xdrx-ssget '((0 . "*polyline"))))
- )
- (progn (mapcar '(lambda (x)
- (setq verts (xdrx-getpropertyvalue x "vertices")
- bulges (xdrx-getpropertyvalue x "bulges")
- m (mapcar '(lambda (y m) (list y m)) verts bulges)
- m (vl-remove-if
- '(lambda (x) (/= (abs (cadr x)) 1.))
- m
- )
- )
- (mapcar '(lambda(y)
- (setq pt (car y)
- seg (xdrx-getpropertyvalue x "nearindex" pt)
- garc (xdrx-getpropertyvalue x "arcsegat" seg)
- pmid (xdrx-getpropertyvalue garc "midpoint"))
- (xdge::free garc)
- (XD::POLYLINE:REMOVE-HALF-CIRCLE x pmid)) m)
- )
- (xdrx-pickset->ents ss)
- )
- )
- )
- )
- (t
- (setq pt (cadr e)
- e (car e)
- )
- (XD::POLYLINE:REMOVE-HALF-CIRCLE e pt)
- )
- )
- )
- )
- (xdrx-end)
- (princ)
- )
|