直线转换为矩形框

sunny_8848

xyp1964 发表于 2022-11-26 13:49
;; 神经元选择，代码需要e派工具箱的支持

谢谢帮忙，可是没有安装您这个工具箱

cq4920

sunny_8848 发表于 2022-11-26 13:56
谢谢帮忙，可是没有安装您这个工具箱

搜索：分堆
不用考虑他原始的样子，直接给她们各自重新套框，图层为图框，打印不可见色，就解决了

sunny_8848

cq4920 发表于 2022-11-26 15:22
搜索：分堆
不用考虑他原始的样子，直接给她们各自重新套框，图层为图框，打印不可见色，就解决了

分堆的方法效率很高，目前在上传的图纸中暂时发现多出一根线条

sunny_8848

;下面分堆的代码效率很高，限制也少。可惜矩形不是在图框层
(defun c:tt (/ wkjl ss lst obj maxp minp flst nlst maxpx maxpy pt )
  (IF (NULL *wkjl) (setq *wkjl 30.0))
   (setq wkjl (GETREAL (strcat "\n外扩距离<" (rtos *wkjl 2 2) ">:")))
   (if (NULL wkjl) (setq wkjl *wkjl) (setq *wkjl wkjl))
  
  (setq ss (ssget))
  (setq  lst
   (mapcar '(lambda (x)
        (setq obj (vlax-ename->vla-object x))
        (vla-getboundingbox obj 'minp 'maxp)
        (setq
          maxp (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
        )
        (setq
          minp (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
        )
        (list x (car minp) (car maxp) (cadr minp) (cadr maxp))
      )
     (vl-remove-if-not
       '(lambda (x) (= 'ENAME (type x)))
       (apply 'append (ssnamex ss))
     )
   )
  )
  (setq  flst (lambda (lst key)
         (if lst
     (if key
       (progn
         (setq nlst   (list (list (caar lst)
               (cadddr (car lst))
               (last (car lst))
         ))
         maxpx (caddar lst)
         lst   (cdr lst)
         )
         (while (and lst (<= (cadar lst) maxpx))
           (setq nlst  (cons (list (caar lst)
                 (cadddr (car lst))
                 (last (car lst))
           )
           nlst
           )
           maxpx (max maxpx (caddar lst))
           lst   (cdr lst)
           )
         )
         (cons nlst (flst lst key))
       )
       (progn
         (setq nlst   (list (caar lst))
         maxpy (caddar lst)
         lst   (cdr lst)
         )
         (while (and lst (<= (cadar lst) maxpy))
           (setq nlst  (cons (caar lst) nlst)
           maxpy (max maxpy (caddar lst))
           lst   (cdr lst)
           )
         )
         (cons nlst (flst lst key))
       )
     )
         )
       )
  )
  (setq
    lst
     (apply
       'append
       (mapcar
   '(lambda (wlst)
      (flst (vl-sort wlst '(lambda (a b) (< (cadr a) (cadr b))))
      nil
      )
    )
   (flst (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))) t)
       )
     )
  )
  (mapcar
    '(lambda (x)
       (setq pt (apply
   'append
   (mapcar
     '(lambda (ent)
        (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
        (list (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
          (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
        )
      )
     x
   )
       ))
       (setq minp (mapcar '- (apply 'mapcar (cons 'min pt)) (list wkjl wkjl)))
       (setq maxp (mapcar '+ (apply 'mapcar (cons 'max pt)) (list wkjl wkjl)))
       (entmake  (list '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          '(90 . 4)
          '(70 . 1)
          '(62 . 1)
          (cons 10 minp)
          (cons 10 (list (car minp) (cadr maxp)))
          (cons 10 maxp)
          (cons 10 (list (car maxp) (cadr minp)))
    )
       )
     )
    lst
  )
  (princ)
)

lee50310

sunny_8848 发表于 2022-11-26 16:37
;下面分堆的代码效率很高，限制也少。可惜矩形不是在图框层
(defun c:tt (/ wkjl ss lst obj maxp minp  ...

如果不考慮程式完成後須  1. 刪除原本外框的舊線段
                                     2. 刪除分堆程式所產生面積為零的重疊線段
只需修改程式1處及新增幾段程式便可很快完成

sunny_8848

谢谢。您给的最后一个文件已经很方便了

lee50310

若要考慮 上述2點
那就需多花些時間來排除

lee50310

了解! 收到...

lxl217114

lee50310 发表于 2022-11-26 08:39
將外圍線替換為矩形框  程式 tt5
執行指令:tt5

很好用，谢谢lee分享。

如果可以批量闭合更好

lee50310

lxl217114 发表于 2022-11-29 16:28
很好用，谢谢lee分享。

如果可以批量闭合更好

批量 將外圍線替換為矩形框
程式已寫好放置 5樓