【排版】拉线等分

marting · 发表于 2020-5-23 18:13:59

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

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

×

(defun c:xdtb_pblxdiv (/ box boxs cen dynpt g i lastpnt
lst lxd mat num op p1 p2 pt pts
ss tf x y
)
(defun _callback (dynpt)
(if (not (equal pt dynpt 1))
(progn
(redraw)
(setq g (xdge::constructor "kLineseg3d" pt dynpt))
(if (= op "A")
(progn
(setq pts (xdrx-getpropertyvalue g "divide" (1+ num)))
(setq pts (xd::list:removehead (xd::list:removetail pts)))
)
(progn
(setq pts (xdrx-getpropertyvalue g "divide" (1- num)))
)
)
(setq i -1
boxs nil
)
(mapcar '(lambda (x)
(setq cen (cadr x)
box (caddr x)
box (xd::pnts:close box)
lxd box
i (1+ i)
mat (xdrx-matrix-settranslation
(mapcar '- (nth i pts) cen)
)
box (xdrx-points-transform box mat)
boxs (cons (xd::geom:get9pt box 5) boxs)
)
(xdrx-grdraw 1 -1 box)
)
lst
)
)
)
(setq lastpnt dynpt)
)
(xdrx-begin)
(xdrx-sysvar-push '("osmode" 545))
(if (and (xdrx-initssget "\n选择要对齐等分的对象<退出>:")
(setq ss (xdrx-ssget))
)
(progn
(if (not op)
(setq op "F")
)
(if (setq pt (getpoint "\n对齐第一点<退出>:"))
(progn
(xdrx-pointmonitor "_callback")
(setq pt (trans pt 1 0)
tf t
box (xdrx-points-ucs2wcs (xdrx-entity-box ss))
p1 (car box)
p2 (last box)
)
(setq lst (mapcar
'(lambda (x)
(setq cen (trans (xd::geom:get9pt x 5) 1 0))
(list (abs (xdrx-point-dist2line cen p1 p2))
cen
(xdrx-points-ucs2wcs (xdrx-entity-box x))
x
)
)
(xdrx-pickset->ents ss)
)
lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
num (length lst)
)
(xdrx-prompt
"\n*** 当前对齐方式:"
(if (= op "A")
" 排除首尾点 "
" 含首尾点 "
)
)
(while
(and tf
(xdrx-initget "A F")
(setq
p2 (getpoint
pt
"\n对齐第二点[排除首尾点(A)/含首尾点(F)]<退出>:"
)
)
)
(cond
((= p2 "A")
(setq op "A")
(_callback lastpnt)
(xdrx-prompt
"\n*** 当前对齐方式:"
(if (= op "A")
" 排除首尾点 "
" 含首尾点 "
)
)
)
((= p2 "F")
(setq op "F")
(_callback lastpnt)
(xdrx-prompt
"\n*** 当前对齐方式:"
(if (= op "A")
" 排除首尾点 "
" 含首尾点 "
)
)
)
(t
(setq tf nil)
(mapcar '(lambda (x) (apply 'xdrx-entity-move x))
(mapcar '(lambda (x y) (list (last x) (cadr x) y))
lst
(reverse boxs)
)
)
)
)
)
)
)
)
)
(redraw)
(xdrx-sysvar-pop)
(xdrx-end)
(princ)
)

(defun c:xdtb_pblxdiv (/    box         boxs cen  dynpt     g          i    lastpnt 
                       lst  lxd         mat  num  op        p1   p2          pt   pts 
                       ss   tf         x    y 
                      ) 
  (defun _callback (dynpt) 
    (if        (not (equal pt dynpt 1)) 
      (progn 
        (redraw) 
        (setq g (xdge::constructor "kLineseg3d" pt dynpt)) 
        (if (= op "A") 
          (progn 
            (setq pts (xdrx-getpropertyvalue g "divide" (1+ num))) 
            (setq pts (xd::list:removehead (xd::list:removetail pts))) 
          ) 
          (progn 
            (setq pts (xdrx-getpropertyvalue g "divide" (1- num))) 
          ) 
        ) 
        (setq i           -1 
              boxs nil 
        ) 
        (mapcar        '(lambda (x) 
                   (setq cen  (cadr x) 
                         box  (caddr x) 
                         box  (xd::pnts:close box) 
                         lxd  box 
                         i    (1+ i) 
                         mat  (xdrx-matrix-settranslation 
                                (mapcar '- (nth i pts) cen) 
                              ) 
                         box  (xdrx-points-transform box mat) 
                         boxs (cons (xd::geom:get9pt box 5) boxs) 
                   ) 
                   (xdrx-grdraw 1 -1 box) 
                 ) 
                lst 
        ) 
      ) 
    ) 
    (setq lastpnt dynpt) 
  ) 
  (xdrx-begin) 
  (xdrx-sysvar-push '("osmode" 545)) 
  (if (and (xdrx-initssget "\n选择要对齐等分的对象<退出>:") 
           (setq ss (xdrx-ssget)) 
      ) 
    (progn 
      (if (not op) 
        (setq op "F") 
      ) 
      (if (setq pt (getpoint "\n对齐第一点<退出>:")) 
        (progn 
          (xdrx-pointmonitor "_callback") 
          (setq        pt  (trans pt 1 0) 
                tf  t 
                box (xdrx-points-ucs2wcs (xdrx-entity-box ss)) 
                p1  (car box) 
                p2  (last box) 
          ) 
          (setq        lst (mapcar 
                      '(lambda (x) 
                         (setq cen (trans (xd::geom:get9pt x 5) 1 0)) 
                         (list (abs (xdrx-point-dist2line cen p1 p2)) 
                               cen 
                               (xdrx-points-ucs2wcs (xdrx-entity-box x)) 
                               x 
                         ) 
                       ) 
                      (xdrx-pickset->ents ss) 
                    ) 
                lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))) 
                num (length lst) 
          ) 
          (xdrx-prompt 
            "\n*** 当前对齐方式:" 
            (if        (= op "A") 
              " 排除首尾点 " 
              " 含首尾点 " 
            ) 
          ) 
          (while 
            (and tf 
                 (xdrx-initget "A F") 
                 (setq 
                   p2 (getpoint 
                        pt 
                        "\n对齐第二点[排除首尾点(A)/含首尾点(F)]<退出>:" 
                      ) 
                 ) 
            ) 
             (cond 
               ((= p2 "A") 
                (setq op "A") 
                (_callback lastpnt) 
                (xdrx-prompt 
                  "\n*** 当前对齐方式:" 
                  (if (= op "A") 
                    " 排除首尾点 " 
                    " 含首尾点 " 
                  ) 
                ) 
               ) 
               ((= p2 "F") 
                (setq op "F") 
                (_callback lastpnt) 
                (xdrx-prompt 
                  "\n*** 当前对齐方式:" 
                  (if (= op "A") 
                    " 排除首尾点 " 
                    " 含首尾点 " 
                  ) 
                ) 
               ) 
               (t 
                (setq tf nil) 
                (mapcar        '(lambda (x) (apply 'xdrx-entity-move x)) 
                        (mapcar        '(lambda (x y) (list (last x) (cadr x) y)) 
                                lst 
                                (reverse boxs) 
                        ) 
                ) 
               ) 
             ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (redraw) 
  (xdrx-sysvar-pop) 
  (xdrx-end) 
  (princ) 
)

fyzld · 发表于 2020-5-23 19:41:26

XUEXIXUEXI

kyky1002 · 发表于 2020-5-24 10:12:57

很独特的功能，谢谢分享

松树石头哥 · 发表于 2020-5-24 17:22:52

感谢楼主分享！！！！！

1917732332 · 发表于 2020-5-25 08:09:53

很有用的功能，谢谢分享

LXH刚开始 · 发表于 2020-5-25 08:23:02

这个很实用的功能，感谢大佬！

yuren008 · 发表于 2020-5-25 10:49:30

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

xdcad2019 · 发表于 2020-5-26 08:00:03

学习了!!!谢谢!!

974778504 · 发表于 2020-5-26 14:13:38

学习了!!!谢谢!!

z562261070 · 发表于 2020-5-30 19:50:13

非常有创意，支持一下

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

[布局、排版] 【排版】拉线等分

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