Lấy ý tưởng từ bài
http://www.cadviet.com/forum/topic/93584-nho-viet-lisp-hatch-vung-kin-cua-cac-doi-tuong-giao-nhau/
Tôi sửa lại lisp của bạn Doan Van Ha như sau:
– Sửa hàm chính: MBCK
– Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là “N”
– Các hàm khác như cũ.
Các bạn check xem còn lỗi nào không
(defun SsNext (e f / ss) (setq ss (ssadd)) (while (setq e (entnext e)) (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss)) ) ) (defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy) (command “undo” “be”) (redraw) (setq sy ‘(“CMDECHO” “OSMODE” “PEDITACCEPT” “DELOBJ”) sv (mapcar ‘getvar sy)) (mapcar ‘setvar sy ‘(0 0 1 1)) (setq col 1) (while (and (princ “nChon cac Line duong truc…”) (setq ss (ssget ‘((0 . “LINE”)))) (setq lsti (vl-remove-if ‘listp (mapcar ‘cadr (ssnamex ss)))) (or kc (setq kc 110)) (setq kc (cond ((getdist (strcat “nBe rong tuong/dam <” (rtos kc 2 2) “>:”))) (kc)))) (mapcar ‘(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) col)) lsti) (setq lst (append (mapcar ‘(lambda(ent) (list ent kc)) lsti) lst)) (setq lstb (append lsti lstb)) (setq col (1+ col))) (command “zoom” “w” (car (setq c (LM:ListBoundingBox lstb))) (cadr c)) (setq lst (reverse lst)) (setq ll (entlast)) (foreach n1 lst (setq lstg1 nil) (foreach n2 lst (if (setq giao (car (HA:Giao (vlax-ename->vla-object (car n1)) (vlax-ename->vla-object (car n2)) acExtendNone))) (setq lstg1 (cons giao lstg1))) ) (if lstg1 (progn (setq i 0 o (cdr (assoc 10 (entget (car n1))))) (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 ‘(lambda(p q) (< (distance p o) (distance q o)) ))1e-10)) (repeat (1- (length lstg1)) (entmake (list (cons 0 “LINE”) (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) )) ) ) )) ;(load “overkillsup.lsp”) (vl-cmdf “._REGION” (SsNext ll nil) “”) (foreach ent (vl-remove-if ‘listp (mapcar ‘cadr (ssnamex (SsNext ll “REGION”)))) (vl-cmdf “._EXPLODE” ent) ;(acet-overkill2 (list (ssget “P”) 1E-3)) (vl-cmdf “PEDIT” “M” “p” “” “J” “” “” ) ) (setq ss (vl-remove-if ‘listp (mapcar ‘cadr (ssnamex (SsNext ll “LWPOLYLINE”))))) (setq ss (vl-sort ss ‘(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) ))) (HA:OffsetInOut (car ss) lst “N”) (foreach ent (cdr ss) (HA:OffsetInOut ent lst “T”)) (mapcar ‘setvar sy sv)(command “undo” “e”) (redraw) (princ)) (defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho) (setq obj1 (car (vlax-invoke obj ‘Offset 1E-1)) obj2 (car (vlax-invoke obj ‘Offset -1E-1))) (if (> (vla-get-area obj1)(vla-get-area obj2)) (setq lon obj1 nho obj2) (setq lon obj2 nho obj1)) (if (> (distance p (vlax-curve-getClosestPointTo lon p))(distance p (vlax-curve-getClosestPointTo nho p))) (if (= flag “T”)(setq flag1 T)) (if (= flag “N”)(setq flag1 T) )) (mapcar ‘vla-delete (list lon nho)) flag1)