删除半圆跨线

newer · 发表于 2020-5-23 15:55:39

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

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

x

本帖最后由 newer 于 2020-5-23 16:49 编辑

需要的函数见开源函数库论坛

（XD::Polyline:Remove-Half-Circle）删除带弧段多段线指定位置的半圆弧

0 个回复 - 0 次查看

2020-5-23 14:36 - newer - 开源函数库

(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)
)

(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) 
)

LXH刚开始 · 发表于 2020-5-23 17:13:15

人家好不容易画出来了，一下就给你删除了，比回退操作还快。哈哈！

tzfcn · 发表于 2020-5-24 14:29:25

有些不明白这个插件的用途，呵呵

fyzld · 发表于 2020-5-24 20:28:20

XUEXIXUEXI

kyky1002 · 发表于 2020-5-25 00:54:15

只能说一声“强”

bszzl167 · 发表于 2020-5-25 10:32:25

斑竹的工具很实用

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

[工具] 删除半圆跨线

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