马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 newer 于 2020-5-23 14:39 编辑
 - (defun XD::Polyline:Remove-Half-Circle
- (e pt / bulge ept g mpt seg spt typ typ1)
- (setq seg (car (xdrx-getpropertyvalue e "onsegat" pt))
- typ (xdrx-polyline-segtype e seg)
- )
- (if (= typ "kArc")
- (progn (setq spt (xdrx-getpropertyvalue e "pointat" (1- seg))
- mpt (xdrx-getpropertyvalue e "pointat" seg)
- ept (xdrx-getpropertyvalue e "pointat" (1+ seg))
- typ1 (xdrx-polyline-segtype e (1- seg))
- )
- (if (= typ1 "kArc")
- (progn (setq g (xdge::constructor "kcircarc3d" spt mpt ept)
- bulge (xdrx-getpropertyvalue g "bulge")
- )
- (xdrx-polyline-removevertexat e (fix seg))
- (xdrx-polyline-setbulgeat e (1- seg) bulge)
- (if (and (= typ1 "kArc")
- (= (xdrx-polyline-segtype e seg) "kArc")
- )
- (progn (setq ept (xdrx-getpropertyvalue e "pointat" (1+ seg))
- g (xdge::constructor "kcircarc3d" spt mpt ept)
- bulge (xdrx-getpropertyvalue g "bulge")
- )
- (xdrx-polyline-removevertexat e (fix seg))
- (xdrx-polyline-setbulgeat e (1- seg) bulge)
- )
- )
- )
- (progn
- (xdrx-polyline-removevertexat e (fix seg))
- (xdrx-polyline-removevertexat e (fix seg))
- )
- )
- )
- )
- )
|