fangmin723 发表于 2021-4-20 14:50:30

(MBWP)打断于多边形（欢迎大佬们多给建议和意见）

本帖最后由 fangmin723 于 2021-4-20 18:56 编辑

;;说明:打断于多边形by-忘霄 2021.4.20
(defun C:MBWP(/ bf-list-split-3d breakapt edta ename ent eptlst getptlst interwithpt ss startbreak);c:MyBreakWithPolygon
(defun breakapt(ent elst iptlst / ilst)
    (foreach e elst
      (if (setq ilst (InterWithPt ent e))
      (foreach p ilst
          (if (not (member p iptlst))
            (progn
            (command "_.BREAK" e "_non" (trans p 0 1) "_non" (trans p 0 1))
            ;(command "_.BREAK" e p "@")
            (breakapt
                ent
                (if (and (= 1 (length (setq ips (InterWithPt ent e)))) (equal (car ips) p 1e-8))
                  (vl-remove e (cons (entlast) elst))
                  (if (and (= 1 (length (setq ips (InterWithPt ent (entlast))))) (equal (car ips) p 1e-8))
                  elst
                  (cons (entlast) elst)
                  )
                )
                (cons p iptlst)
            )
            )
          )
      )
      )
    )
)
(defun InterWithPt(ent1 ent2 / bf-list-split-3d var)
    (defun BF-list-split-3d (lst)
      (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))
    )
    (if (> (vlax-safearray-get-u-bound (setq var (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object ent1) (vlax-ename->vla-object ent2) acExtendNone))) 1) 1)
      (BF-list-split-3d (vlax-safearray->list var))
      nil
    )
)
(defun getptlst(e) (mapcar 'cdr (vl-remove-if-not (function (lambda(x) (= 10 (car x)))) (entget e))))
(defun BF-list-split-3d (lst)
    (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))
)
(defun startbreak(ent ss / ient inlst n)
    (setq n -1)
    (while (setq ient (ssname ss (setq n (1+ n))))
      (if (setq inlst (InterWithPt ent ient))
      (breakapt ent (list ient) '())
      )
    )
)
(command "_.UNDO" "be")
(if (setq ent (car (entsel "\n请选择【直线】或者【由多段线构成的多边形】：")))
    (progn
      (setq ename (cdr (assoc 0 (setq edta (entget ent)))))
      (cond
      ((equal ename "LINE")
          (setq ss (ssdel ent (ssget "F" (list (cdr (assoc 10 edta)) (cdr (assoc 11 edta))))))
          (startbreak ent ss)
      )
      ((equal ename "LWPOLYLINE")
          (if (<= (length (setq eptlst (getptlst ent))) 2)
            (setq ss (ssdel ent (ssget "F" eptlst)))
            (setq ss (ssdel ent (ssget "CP" (append (setq eptlst (getptlst ent)) (list (car eptlst))))))
          )
          (startbreak ent ss)
      )
      )
    )
)
(command "_.UNDO" "e")
(prin1)
)

meja 发表于 2021-4-22 02:54:12

又不能生成面域，否则功能会十分强大

xj6019 发表于 2021-4-22 07:28:52

感谢大佬的分享精神

fangmin723 发表于 2021-4-22 08:52:57

meja 发表于 2021-4-22 02:54
又不能生成面域，否则功能会十分强大

生成面域论坛应该有，我记得G版写过一个
页: [1]
查看完整版本: (MBWP)打断于多边形（欢迎大佬们多给建议和意见）