;http://www.cadviet.com/forum/topic/71578-da-xong-lenh-trim-mo-rong/ ;27/5/2013. Doan Van Ha -CadViet.com ;Co 3 kieu Trim: ;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset). ;2). Trim doan Ngan: Trim phan ngan. ;3). Trim doan Dai: Trim phan dai. ;Khong Trim cac truong hop: doi tuong la duong kin ; giao nhau tai hon 1 diem; giao nhau bieu kien. (defun C:HA( / ent0 ent ent2 ss typ ento lstg lst len1 len2) (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (if (and (princ "\nChon 1 doi tuong dao cat...") (setq ss (ssget ":S" '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))) (setq ent0 (ssname ss 0)) (princ "\nChon cac doi tuong bi cat...") (setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc"))))) (progn (initget "P N D") (setq typ (getkword "\nChon kieu Trim [theo_Phia/doan_Ngan/doan_Dai]
: ")) (if (not typ) (setq typ "P")) (if (= typ "P") (progn (initget 65) (setq p (getdist (GetP (vlax-curve-getStartPoint ent0) (vlax-curve-getEndPoint ent0) (/ (HA:LenCur ent0) 2) ent0) "\nPick chon phia can Trim: ")) (command "offset" 1E-3 ent0 p "") (setq ento (entlast)))) (setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssadd ent0 ss))))))) (command "zoom" "w" (setq pll (car (LM:ListBoundingBox objlst))) (setq pur (cadr (LM:ListBoundingBox objlst)))) (foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq lstg (HA:Giao (vlax-ename->vla-object ent0) (vlax-ename->vla-object ent1) acExtendNone)) (if (and (= (length lstg) 1) (not (equal (car lstg) (vlax-curve-getStartPoint ent1) 1E-3)) (not (equal (car lstg) (vlax-curve-getEndPoint ent1) 1E-3))) (progn (setq lst (HA:GetNewEnt12 ent1 pll pur (car lstg))) (setq len1 (HA:LenCur (setq ent1 (car lst))) len2 (HA:LenCur (setq ent2 (cadr lst)))) (cond ((or (and (= typ "N") (> len1 len2)) (and (= typ "D") (< len1 len2))) (entdel ent2)) ((or (and (= typ "N") (< len1 len2)) (and (= typ "D") (> len1 len2))) (entdel ent1)) ((= typ "P") (if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone) (entdel ent1) (entdel ent2))))))) (if ento (entdel ento)))) (command "undo" "e") (setvar "cmdecho" cmd) (setvar "osmode" osm) (princ)) (defun GetP (pg ph kc cur / dg dh dp) (setq dg (vlax-curve-getDistAtPoint cur pg)) (setq dh (vlax-curve-getDistAtPoint cur ph)) (if (> dh dg) (setq dp (+ dg kc)) (setq dp (- dg kc))) (vlax-curve-getPointAtDist cur dp)) (defun HA:GetNewEnts1(ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new) (defun HA:GetNewEnt12(ent pll pur pt / typ1 ss1 ss2 entlst) (setq typ1 (cdr (assoc 0 (entget ent)))) (setq ss1 (ssget "c" pll pur '((0 . "POLYLINE")))) (command ".break" ent pt pt) (if (equal typ1 "POLYLINE") (progn (setq ss2 (ssadd)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "c" pll pur '((0 . "POLYLINE")))))) (if (not (ssmemb ent ss1)) (ssadd ent ss2)) (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))) (list (car entlst) (cadr entlst)))) (list ent (entlast)))) (defun HA:LenCur(ent) (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))) (defun HA:Giao(obj1 obj2 mode / l r) (setq l (vlax-invoke obj1 'intersectwith obj2 mode)) (repeat (/ (length l) 3) (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l))) r) (defun LM:ListBoundingBox(objlst / l1 l2 ll ur) (foreach obj objlst (vla-getboundingbox obj 'll 'ur) (setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2))) (mapcar (function (lambda(a b) (apply 'mapcar (cons a b)))) '(min max) (list l1 l2)))