(求助)批量生成内轮廓

KO你 · 发表于 2022-11-14 22:25:32

CAD默认的边界创建BOUNDARY命令，点就行了

999999 · 发表于 2022-11-14 22:34:30

KO你发表于 2022-11-14 22:25
CAD默认的边界创建BOUNDARY命令，点就行了

我也知道是点，就是像有个插件直接实现，就可以节省时间哇

xyp1964 · 发表于 2022-11-15 12:36:31

999999 发表于 2022-11-14 22:34
我也知道是点，就是像有个插件直接实现，就可以节省时间哇

可以按面积大小控制所要的区域，代码已经上传

999999 · 发表于 2022-11-15 12:49:33

xyp1964 发表于 2022-11-15 12:36
可以按面积大小控制所要的区域，代码已经上传

好的哦，谢谢院长大人

x_s_s_1 · 发表于 2022-11-15 16:44:24

仅针对此例

(defun xty-get-dxf (code en) (cdr (assoc code (entget en))))
(defun xty-get-plptlist (en fuzz /)
(xty-L-delsames
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
)
fuzz
)
)
(defun xty-get-intpts (ss fuzz / lst obj boj1 ptlst pts)
(setq lst (xty-tr-ss2lst ss nil))
(while lst
(setq obj (car lst)
lst (cdr lst)
)
(foreach obj1 lst
(setq ptlst (if (setq pts (xty-tr-value2list
(vlax-invoke-method
obj
'intersectwith
obj1
acextendnone
)
)
)
(cons (xty-L-cai pts 3) ptlst)
ptlst
)
)
)
)
(if ptlst
(xty-L-delsames (apply 'append ptlst) fuzz)
)
)
(defun xty-tr-value2list (value)
(setq value (vl-catch-all-apply
(function vlax-safearray->list)
(list (vlax-variant-value value))
)
)
(if (= (type value) (function LIST))
value
nil
)
)
(defun xty-tr-ss2lst (ss form / n en lst)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq lst (cons en lst))
)
(setq lst(reverse lst))
(if form lst (mapcar(function vlax-ename->vla-object)lst))
)
(defun xty-L-delsames (lst fuzz / start new)
(while (setq start (car lst))
(if (vl-some '(lambda (x) (equal start x fuzz)) new)
nil
(setq new (cons start new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(defun xty-L-cai (lst n / a lst1 lst2)
(setq a (length lst))
(if (/= 0 (setq a (rem a n)))
(repeat a (setq lst (append lst (list nil)))))
(while lst
(repeat n
(setq lst1 (cons (car lst) lst1)
lst (cdr lst)
)
)
(setq lst2 (cons (reverse lst1) lst2)
lst1 nil
)
)
(reverse lst2)
)
(defun c:tt (/ dis en lst md old ss)
(setq md 20) ;_根据实际需要，最大边框宽
(setq old (getvar 'clayer)
ss (ssget '((0 . "*line")))
lst (vl-remove-if-not
'(lambda (x) (= "LWPOLYLINE" (xty-get-dxf 0 x)))
(xty-tr-ss2lst ss t)
)
lst (apply 'append
(mapcar '(lambda (x) (xty-get-plptlist x 1e-6)) lst)
)
lst (xty-L-delsames (append lst (xty-get-intpts ss 1e-6)) 1e-6)
)
(setvar 'clayer "YB2")
(foreach n lst
(if (setq en (bpoly (mapcar '+ n (list (* 0.5 md) (* 0.5 md)))
ss
'(0 0 0)
)
)
(progn (setq dis (xty-get-plptlist en 1e-6)
dis (mapcar '(lambda (x y) (distance x y)) dis (cdr dis))
dis (vl-sort dis '<)
dis (car dis)
)
(if (or (> md dis) (equal md dis 1e-6))
(entdel en)
)
)
)
)
(setvar 'clayer old)
)

(defun xty-get-dxf (code en) (cdr (assoc code (entget en)))) 
(defun xty-get-plptlist  (en fuzz /) 
  (xty-L-delsames 
    (mapcar 'cdr 
      (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en)) 
    ) 
    fuzz 
  ) 
) 
(defun xty-get-intpts (ss fuzz / lst obj boj1 ptlst pts) 
  (setq lst (xty-tr-ss2lst ss nil)) 
  (while lst 
    (setq obj (car lst) 
    lst (cdr lst) 
    ) 
    (foreach obj1 lst 
      (setq ptlst (if (setq pts  (xty-tr-value2list 
          (vlax-invoke-method 
            obj 
            'intersectwith 
            obj1 
            acextendnone 
          ) 
        ) 
          ) 
        (cons (xty-L-cai pts 3) ptlst) 
        ptlst 
      ) 
      ) 
    ) 
  ) 
  (if ptlst 
    (xty-L-delsames (apply 'append ptlst) fuzz) 
  ) 
) 
(defun xty-tr-value2list (value) 
  (setq  value (vl-catch-all-apply 
    (function vlax-safearray->list) 
    (list (vlax-variant-value value)) 
        ) 
  ) 
  (if (= (type value) (function LIST)) 
    value 
    nil 
  ) 
) 
(defun xty-tr-ss2lst (ss form / n en lst) 
  (repeat (setq n (sslength ss)) 
    (setq en (ssname ss (setq n (1- n)))) 
    (setq lst (cons en lst)) 
  ) 
  (setq lst(reverse lst)) 
  (if form lst (mapcar(function vlax-ename->vla-object)lst)) 
) 
(defun xty-L-delsames  (lst fuzz / start new) 
  (while (setq start (car lst)) 
    (if  (vl-some '(lambda (x) (equal start x fuzz)) new) 
      nil 
      (setq new (cons start new)) 
      ) 
    (setq lst (cdr lst)) 
    ) 
  (setq new (reverse new)) 
  new 
  ) 
(defun xty-L-cai  (lst n / a lst1 lst2) 
  (setq a (length lst)) 
  (if (/= 0 (setq a (rem a n))) 
    (repeat a (setq lst (append lst (list nil))))) 
  (while lst 
    (repeat n 
      (setq lst1 (cons (car lst) lst1) 
      lst   (cdr lst) 
      ) 
      ) 
    (setq lst2 (cons (reverse lst1) lst2) 
    lst1 nil 
    ) 
    ) 
  (reverse lst2) 
  ) 
(defun c:tt (/ dis en lst md old ss) 
  (setq md 20) ;_根据实际需要，最大边框宽 
  (setq  old (getvar 'clayer) 
  ss  (ssget '((0 . "*line"))) 
  lst (vl-remove-if-not 
        '(lambda (x) (= "LWPOLYLINE" (xty-get-dxf 0 x))) 
        (xty-tr-ss2lst ss t) 
      ) 
  lst (apply 'append 
       (mapcar '(lambda (x) (xty-get-plptlist x 1e-6)) lst) 
      ) 
  lst (xty-L-delsames (append lst (xty-get-intpts ss 1e-6)) 1e-6) 
  ) 
  (setvar 'clayer "YB2") 
  (foreach n lst 
    (if  (setq en (bpoly  (mapcar '+ n (list (* 0.5 md) (* 0.5 md))) 
      ss 
      '(0 0 0) 
     ) 
  ) 
      (progn (setq dis (xty-get-plptlist en 1e-6) 
       dis (mapcar '(lambda (x y) (distance x y)) dis (cdr dis)) 
       dis (vl-sort dis '<) 
       dis (car dis) 
       ) 
       (if (or (> md dis) (equal md dis 1e-6)) 
         (entdel en) 
       ) 
      ) 
    ) 
  ) 
  (setvar 'clayer old) 
)

999999 · 发表于 2022-11-15 17:46:28

x_s_s_1 发表于 2022-11-15 16:44
仅针对此例

大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到的就是想要的

999999 · 发表于 2022-11-16 11:55:46

999999 发表于 2022-11-15 17:46
大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到 ...

大神您好，我复制的代码是这样的，运行出现这种情况呢

999999 · 发表于 2022-11-16 11:57:11

999999 发表于 2022-11-15 17:46
大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到 ...

大神您好，您看一下底下我复制您的代码发出的附件

999999 · 发表于 2022-11-17 11:41:09

999999 发表于 2022-11-16 11:55
大神您好，我复制的代码是这样的，运行出现这种情况呢

我试了几次没有反应呢

x_s_s_1 · 发表于 2022-11-18 08:44:01

999999 发表于 2022-11-17 11:41
我试了几次没有反应呢

你没复制对吧，我也是复制的网页代码，没问题啊

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

[提问] (求助)批量生成内轮廓

本帖子中包含更多资源

点评

本帖子中包含更多资源

点评

本帖子中包含更多资源