批量平行直线端点连接

newer · 发表于 2020-5-13 03:18:32

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

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

×

本帖最后由 newer 于 2020-5-13 13:22 编辑

(defun c:xdtb_lnendconect (/ g ents x xdir pts ents ln y lst)
(defun _keyword (keyword)
(cond ((= keyword "1") (setq #xd-var-global-left-right 0))
((= keyword "2") (setq #xd-var-global-left-right 1))
((= keyword "3") (setq #xd-var-global-left-right 2))
)
(_prompt)
)
(defun _prompt ()
(xdrx_prompt
"\n>>当前设置："
(cond ((= 1 #xd-var-global-left-right) "连接左下端点.")
((= 2 #xd-var-global-left-right) "连接右上端点.")
((= 3 #xd-var-global-left-right) "两端都连.")
)
)
)
(defun _mkpline (pts)
(setq g (xdge::constructor "kcompositecrv3d" pts))
(xdrx-entity-make g)
(xdge::free g)
)
(if (not #xd-var-global-left-right)
(setq #xd-var-global-left-right 0)
)
(xdrx-begin)
(while
(and (_prompt)
(xdrx-initget "1 2 3")
(xdrx-initssget
"\n选择要连接端点的曲线[连接左下(1)/连接右上(2)/两端都连(3)]<退出>:"
"0 1 2"
""
"_keyword"
)
(setq ss (xdrx-ssget '((0 . "line"))))
)
(setq lst (xd::list:groupbyindex
(mapcar '(lambda (x)
(setq ln (xdrx-getpropertyvalue x "vertices")
an (xdrx-getpropertyvalue x "angle")
an (xd::geom:angleformat an)
)
(list an x)
)
(xdrx-pickset->ents ss)
)
0.001
)
)
(setq lst (mapcar '(lambda (x)
(setq ents (cdr x)
xdir (xdrx-vector-normalize
(mapcar '-
(polar '(0 0 0) (car x) 1.0)
'(0 0 0)
)
)
)
(setq box (xdrx-entity-box ents xdir))
(setq ents (mapcar '(lambda (y)
(setq p1 (xdrx-getpropertyvalue y "startpoint")
dis (abs (xdrx-point-dist2line
p1
(car box)
(cadr box)
)
)
)
(list dis y)
)
ents
)
)
(setq ents
(vl-sort ents '(lambda (x y) (< (car x) (car y))))
)
(mapcar 'cadr ents)
)
lst
)
)
(setq lst (mapcar '(lambda (x)
(mapcar '(lambda (y)
(setq ln (xdrx-getpropertyvalue y "vertices")
an (xdrx-getpropertyvalue y "angle")
an (xd::geom:angleformat an)
)
(if (> an (/ pi 2))
(reverse ln)
ln
)
)
x
)
)
lst
)
)
(xdrx_setmark)
(mapcar
'(lambda (x)
(cond
((= #xd-var-global-left-right 1) (_mkpline (mapcar 'car x)))
((= #xd-var-global-left-right 2) (_mkpline (mapcar 'cadr x)))
(t (_mkpline (mapcar 'car x))(_mkpline (mapcar 'cadr x)))
)
)
lst
) (xdrx-setpropertyvalue (xdrx_getss) "color" 6)
)
(xdrx-end)
(princ)
)

(defun c:xdtb_lnendconect (/ g ents x xdir pts ents ln y lst) 
  (defun _keyword (keyword) 
    (cond ((= keyword "1") (setq #xd-var-global-left-right 0)) 
          ((= keyword "2") (setq #xd-var-global-left-right 1)) 
           ((= keyword "3") (setq #xd-var-global-left-right 2)) 
   ) 
    (_prompt) 
  ) 
  (defun _prompt () 
    (xdrx_prompt 
      "\n>>当前设置：" 
      (cond ((= 1 #xd-var-global-left-right) "连接左下端点.") 
            ((= 2 #xd-var-global-left-right) "连接右上端点.") 
            ((= 3 #xd-var-global-left-right) "两端都连.") 
      ) 
    ) 
  ) 
  (defun _mkpline (pts) 
    (setq g (xdge::constructor "kcompositecrv3d" pts)) 
    (xdrx-entity-make g) 
    (xdge::free g) 
  ) 
  (if (not #xd-var-global-left-right) 
    (setq #xd-var-global-left-right 0) 
  ) 
  (xdrx-begin) 
  (while 
    (and (_prompt) 
         (xdrx-initget "1 2 3") 
         (xdrx-initssget 
           "\n选择要连接端点的曲线[连接左下(1)/连接右上(2)/两端都连(3)]<退出>:" 
           "0 1 2" 
           "" 
           "_keyword" 
         ) 
         (setq ss (xdrx-ssget '((0 . "line")))) 
    ) 
     (setq lst (xd::list:groupbyindex 
                 (mapcar '(lambda (x) 
                            (setq ln (xdrx-getpropertyvalue x "vertices") 
                                  an (xdrx-getpropertyvalue x "angle") 
                                  an (xd::geom:angleformat an) 
                            ) 
                            (list an x) 
                          ) 
                         (xdrx-pickset->ents ss) 
                 ) 
                 0.001 
               ) 
     ) 
     (setq lst (mapcar '(lambda        (x) 
                          (setq        ents (cdr x) 
                                xdir (xdrx-vector-normalize 
                                       (mapcar '- 
                                               (polar '(0 0 0) (car x) 1.0) 
                                               '(0 0 0) 
                                       ) 
                                     ) 
                          ) 
                          (setq box (xdrx-entity-box ents xdir)) 
                          (setq        ents (mapcar '(lambda (y) 
                                                (setq p1  (xdrx-getpropertyvalue y "startpoint") 
                                                      dis (abs (xdrx-point-dist2line 
                                                                 p1 
                                                                 (car box) 
                                                                 (cadr box) 
                                                               ) 
                                                          ) 
                                                ) 
                                                (list dis y) 
                                              ) 
                                             ents 
                                     ) 
                          ) 
                          (setq        ents 
                                 (vl-sort ents '(lambda (x y) (< (car x) (car y)))) 
                          ) 
                          (mapcar 'cadr ents) 
                        ) 
                       lst 
               ) 
     ) 
     (setq lst (mapcar '(lambda        (x) 
                          (mapcar '(lambda (y) 
                                     (setq ln (xdrx-getpropertyvalue y "vertices") 
                                           an (xdrx-getpropertyvalue y "angle") 
                                           an (xd::geom:angleformat an) 
                                     ) 
                                     (if (> an (/ pi 2)) 
                                       (reverse ln) 
                                       ln 
                                     ) 
                                   ) 
                                  x 
                          ) 
                        ) 
                       lst 
               ) 
     ) 
    (xdrx_setmark) 
     (mapcar 
       '(lambda        (x) 
          (cond 
            ((= #xd-var-global-left-right 1) (_mkpline (mapcar 'car x))) 
            ((= #xd-var-global-left-right 2) (_mkpline (mapcar 'cadr x))) 
            (t (_mkpline (mapcar 'car x))(_mkpline (mapcar 'cadr x))) 
          ) 
        ) 
       lst 
     )          (xdrx-setpropertyvalue (xdrx_getss) "color" 6) 
 
  ) 
  (xdrx-end) 
  (princ) 
)

98101yin · 发表于 2020-5-13 07:31:47

厉害了，我要保存一下666666666666666

啊龍 · 发表于 2020-5-13 08:01:05

厲害了，我要保存一下

kyky1002 · 发表于 2020-5-13 08:01:27

好奇特的功能，下来看看

yuren008 · 发表于 2020-5-13 08:45:07

谢谢楼主分享，不错的插件。

LXH刚开始 · 发表于 2020-5-13 09:03:07

每天到论坛来逛逛，都会有意想不到的收获。

tzfcn · 发表于 2020-5-13 09:16:16

这个代码的用处还是很多的。

猪八戒悟能 · 发表于 2020-5-13 13:12:57

感谢楼主分享

fyzld · 发表于 2020-5-13 16:10:13

谢谢楼主分享

昵称不要脸 · 发表于 2020-5-14 22:01:28

厉害了，我的哥

bai0371 · 发表于 2020-5-15 08:33:09

只对平行线有用？？？？？

bszzl167 · 发表于 2020-5-16 06:21:48

最终修改的，更牛逼！！！

liuwenxuan8351 · 发表于 2020-5-18 12:49:51

好先进的科技收藏了

974778504 · 发表于 2020-5-28 13:46:05

不错的，谢谢楼主分享。

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

[工具] 批量平行直线端点连接

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