【已解决】求批量矩形中心点与限定范围内直线的连接线

261789003 · 发表于 2024-3-27 01:44:35

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

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

×

本帖最后由 261789003 于 2024-4-3 03:02 编辑

QQ图片20240327014137.png

求批量矩形中心点与限定范围内直线的连接线，求大神出手

XDSoft · 发表于 2024-3-29 03:37:17

(defun c:xdtb_rect_connect_line ( / _nearpt _tol box ents ints n pts rects ss v x)
(defun _get-rectang (ss)
(vl-remove nil
(mapcar '(lambda (x)
(if (XD::Polyline:IsRectang x)
x
nil
)
)
(xdrx-pickset->ents ss)
)
)
)
(defun _safezoom (pts)
(if (not
(xdrx_points_isinscreen (setq pts (xdrx-points-box pts)))
)
(xdrx-document-zoomwindow (nth 0 pts) (nth 2 pts))
)
)
(defun _safezoom (pts)
(xdrx-document-safezoom box)
)
(defun _extend-and-connect (ents)
(defun _connect (x n)
(xdrx-line-make
_nearpt
(xdrx-getpropertyvalue x "centroid")
)
(xdrx-entity-matchprop n (entlast))
)
(defun _extend (n _nearpt)
(or (xdrx-curve-extend n _nearpt nil)
(xdrx-curve-extend n _nearpt t)
)
)
(mapcar
'(lambda (x)
(setq box (xdrx-entity-box x)
box (xd::pnts:close box)
box (xdrx-points-offset _tol box)
)
(if (setq ss (ssget "cp" box '((0 . "line"))))
(progn
(foreach n (xdrx-ss->ents ss)
(if (setq ints (xdrx-get-inters n x 3))
(progn
(setq
_nearpt (xdrx-points-nearpt
(xdrx-getpropertyvalue n "startpoint")
ints
)
)
(_extend n _nearpt)
(_connect x n)
)
)
)
)
)
)
ents
)
)
;main
(if (not #xd-var-global-tol)
(setq #xd-var-global-tol 1.0)
)
(if (setq
v (getreal
(xdrx-prompt
(xdrx-string-multilanguage
"\n输入模糊搜索精度距离<"
"\nInput Fuzzy search accuracy distance<"
)
#xd-var-global-tol
">"
t
)
)
)
(setq #xd-var-global-tol v)
)
(setq _tol (* 1.1 #xd-var-global-tol))
(if (setq ss (xdrx-ssget
(xdrx-string-multilanguage
"\n选择矩形<退出>:"
"\nSelect Rectang<Exit>"
)
'((0 . "*polyline") (70 . 1))
)
)
(progn
(xdrx-begin)
(setq rects (_get-rectang ss)
box (xdrx-entity-box rects)
box (xd::pnts:close box)
box (xdrx-points-offset _tol box)
)
(_safezoom box)
(_extend-and-connect rects)
(xdrx_end)
)
)
(princ)
)

(defun c:xdtb_rect_connect_line ( / _nearpt _tol box ents ints n pts rects ss v x) 
  (defun _get-rectang (ss) 
    (vl-remove nil 
               (mapcar '(lambda        (x) 
                          (if (XD::Polyline:IsRectang x) 
                            x 
                            nil 
                          ) 
                        ) 
                       (xdrx-pickset->ents ss) 
               ) 
    ) 
  ) 
  (defun _safezoom (pts) 
    (if        (not 
          (xdrx_points_isinscreen (setq pts (xdrx-points-box pts))) 
        ) 
      (xdrx-document-zoomwindow (nth 0 pts) (nth 2 pts)) 
    ) 
  ) 
  (defun _safezoom (pts) 
      (xdrx-document-safezoom box) 
  ) 
  (defun _extend-and-connect (ents) 
    (defun _connect (x n) 
      (xdrx-line-make 
        _nearpt 
        (xdrx-getpropertyvalue x "centroid") 
      ) 
      (xdrx-entity-matchprop n (entlast)) 
    ) 
    (defun _extend (n _nearpt) 
      (or (xdrx-curve-extend n _nearpt nil) 
          (xdrx-curve-extend n _nearpt t) 
      ) 
    ) 
    (mapcar 
      '(lambda (x) 
         (setq box (xdrx-entity-box x) 
               box (xd::pnts:close box) 
               box (xdrx-points-offset _tol box) 
         ) 
         (if (setq ss (ssget "cp" box '((0 . "line")))) 
           (progn 
             (foreach n        (xdrx-ss->ents ss) 
               (if (setq ints (xdrx-get-inters n x 3)) 
                 (progn 
                   (setq 
                     _nearpt (xdrx-points-nearpt 
                               (xdrx-getpropertyvalue n "startpoint") 
                               ints 
                             ) 
                   ) 
                   (_extend n _nearpt) 
                   (_connect x n) 
                 ) 
               ) 
             ) 
           ) 
         ) 
       ) 
      ents 
    ) 
  ) 
  ;main 
  (if (not #xd-var-global-tol) 
    (setq #xd-var-global-tol 1.0) 
  ) 
  (if (setq 
        v (getreal 
            (xdrx-prompt 
              (xdrx-string-multilanguage 
                "\n输入模糊搜索精度距离<" 
                "\nInput Fuzzy search accuracy distance<" 
              ) 
              #xd-var-global-tol 
              ">" 
              t 
            ) 
          ) 
      ) 
    (setq #xd-var-global-tol v) 
  ) 
  (setq _tol (* 1.1 #xd-var-global-tol)) 
  (if (setq ss (xdrx-ssget 
                 (xdrx-string-multilanguage 
                   "\n选择矩形<退出>:" 
                   "\nSelect Rectang<Exit>" 
                 ) 
                 '((0 . "*polyline") (70 . 1)) 
               ) 
      ) 
    (progn 
      (xdrx-begin) 
      (setq rects (_get-rectang ss) 
            box  (xdrx-entity-box rects) 
            box (xd::pnts:close box) 
            box          (xdrx-points-offset _tol box) 
      ) 
       
      (_safezoom box) 
      (_extend-and-connect rects) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

261789003 · 发表于 2024-4-3 02:52:07

XDSoft 发表于 2024-3-29 03:37

大佬威武，非常谢谢东哥分享

kmliro_2017 · 发表于 2024-4-9 07:38:19

不错，谢谢分享！！！！

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

[编程申请] 【已解决】求批量矩形中心点与限定范围内直线的连接线

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