[Đã xong] Lệnh Trim mở rộng

Tháng 5 26, 2013

Xuất phát từ nhu cầu Trim cần có nhiều lựa chọn hơn nữa so với lệnh Trim gốc của Cad, tôi viết lisp này để phục vụ bà con lối xóm.

Trên forum đã có vài topic nói về Trim mở rộng, nhưng theo những nhu cầu khác nhau, nằm lẻ tẻ, và hầu như cũng chưa hoàn thiện lắm.

Lệnh Trim mở rộng này có 3 tùy chọn: Trim theo từng phía + Trim đoạn ngắn + Trim đoạn dài.

Đối tượng Trim: Line, Polyline, Lwpolyline, Spline, Arc.

Ai tải về dùng tốt thì nhớ like. Ai thấy chưa ưng bụng thì góp ý để sửa, đừng ném đá.

Hình để xem:

File Cad để test:

http://www.cadviet.com/upfiles/3/67029_trim_nguoc.dwg

File Lsp để dùng:

;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 p ento lstg len1 len2)

(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0)

(if

(and

(setq ent0 (car (entsel "\nChon 1 doi tuong dao cat: ")))

(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))))

(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 ent (entlast))

(command ".break" ent1 "_non" (car lstg) "_non" (car lstg))

(setq ent2 (car (HA:GetNewEnts ent)))

(setq len1 (HA:LenCur ent1) len2 (HA:LenCur ent2))

(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) (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:GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)

(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)

Tháng 5 27, 2013

Xuất phát từ nhu cầu Trim cần có nhiều lựa chọn hơn nữa so với lệnh Trim gốc của Cad, tôi viết lisp này để phục vụ bà con lối xóm.

...........................

;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 p ento lstg len1 len2)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0)
 (if
  (and
   (setq ent0 (car (entsel "\nChon 1 doi tuong dao cat: ")))
   (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] <P>: "))
   (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))))
   (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 ent (entlast))
      (command ".break" ent1 "_non" (car lstg) "_non" (car lstg))
      (setq ent2 (car (HA:GetNewEnts ent)))
      (setq len1 (HA:LenCur ent1) len2 (HA:LenCur ent2))
      (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) (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:GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)
(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)

Hàm này : (defun HA:GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)

gặp (setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))

bởi "entnext" của POLYLINE ra Vertext.

nên thay, nên thay -> Nếu gặp đối tượng là POLYLINE: Lisp sẽ lỗi ngay..............

Tháng 5 27, 2013

Thank bác Tue_NV đã phát hiện ra lỗi với POLYLINE. Chưa test nó nên sinh lắm chuyện phiền hà khi gặp nó.

Code mới.

;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 p ento lstg lst len1 len2)

(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 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))

(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) (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 "_non" pt "_non" 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)))

Tháng 5 27, 2013

Chưa xong đâu bác.

Trim phía nào -> lisp cũng cho kết quả là Trim phía bên tay trái dao cắt.....

Tháng 5 27, 2013

Sao kỳ vậy? Tôi test ok mà. Gởi cho tôi bản vẽ ấy để test nhé.

Tháng 5 27, 2013

Sao kỳ vậy? Tôi test ok mà. Gởi cho tôi bản vẽ ấy để test nhé.

Đây bác :

http://www.cadviet.com/upfiles/3/4652_test_1.dwg

Tháng 5 27, 2013

Phát hiện ra rồi! Chắc do thiếu "non"?

Code chép lên 4R tự dưng nó mất đi mấy chữ rất buồn cười: mất chu "kin", mất dòng "Chon cac doi tuong bi cat..."

4R dạo này lỡ post lisp là không sửa code lisp được, đành phải post bài mới tốn đất. Không biết mọi người có bị như tôi không?

;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)))

Tháng 5 27, 2013

Phát hiện ra rồi! Chắc do thiếu "non"?

Code chép lên 4R tự dưng nó mất đi mấy chữ rất buồn cười: mất chu "kin", mất dòng "Chon cac doi tuong bi cat..."

4R dạo này lỡ post lisp là không sửa code lisp được, đành phải post bài mới tốn đất. Không biết mọi người có bị như tôi không?

Có 2 nhược điểm ngoài "Không trim các Trường hợp" mà bác nêu ra:

1./ Lisp không áp dụng cho con dao cắt PLINE, Spline cắt nhau (tức là không áp dụng cho con dao cắt PLINE, Spline kín, đại loại con dao nào mà khi offset 0.001 thì dao bị vỡ ra thì không được)

2./ Đoạn hở 0.001 của đối tượng bị cắt (thò qua con dao cắt thì cắt không được)

Hai nhược điểm này phát sinh từ thuật toán của bác, dùng thằng Offset

Tháng 5 28, 2013

Phải thế thôi. Chúng ta vẫn thường (equal p1 p2 1E-8) hay (equal p1 p2 1E-15) đấy thôi.

Đem 1E-9 và 1E-16 ra mà so sánh thì sẽ... cúm gà hết. :lol:

Tháng 5 28, 2013

Phải thế thôi. Chúng ta vẫn thường (equal p1 p2 1E-8) hay (equal p1 p2 1E-15) đấy thôi.

Đem 1E-9 và 1E-16 ra mà so sánh thì sẽ... cúm gà hết. :lol:

Đi theo con đường "Trim" không dùng "offset" thì mọi việc sẽ khác. Sẽ không phải như thế được.

Trim là nó trim ngay gốc chứ không phải Offset ra 0,001 rồi xử. Vậy vô tình có đoạn nào đó thò ra 0.001 thì Lisp chịu rồi.

Con dao cắt có thể là 1 đường Spline uốn éo bất kì, giờ muốn trim đoạn dài, hay đoạn ngắn của đối tượng cắt qua con dao đó thì Lisp có thể sẽ chịu. Lẽ nào bác để vậy sao? Tại biết bác không đặt chữ "kệ" làm nền tảng nên Tue_NV mới nói vậy, còn không thì thôi, cứ để "Kệ" làm nền tảng vậy.

Tháng 5 28, 2013

Hướng khác thì có. Nói ở đây là nói cái chuyện sai số thôi, kiểu hay dùng 1E-8 và 1E-9 ấy mà. Sẽ bỏ offset luôn cho nó khỏi lằng nhằng.

Bác Tue_NV có hướng nào tư vấn giùm, code mà có hướng thì chắc làm được.

Tháng 5 28, 2013

Phát hiện ra rồi! Chắc do thiếu "non"?

Code chép lên 4R tự dưng nó mất đi mấy chữ rất buồn cười: mất chu "kin", mất dòng "Chon cac doi tuong bi cat..."

4R dạo này lỡ post lisp là không sửa code lisp được, đành phải post bài mới tốn đất. Không biết mọi người có bị như tôi không?

.................

Hà upload file Lisp lên đi, copy code từ forum bị nhiều lỗi "ngô nghê" quá.

Tháng 5 28, 2013

Đây bác. Dạo này up, edit... code lisp cực nhiêu khê.

http://www.cadviet.com/upfiles/3/67029_trim_mo_rong_ha.lsp

Tháng 5 28, 2013

Chưa có đ/kiện test trên Cad khác.

Với Cad 2010 tại dòng nhắc : "Chon kieu Trim [theo_Phia/doan_Ngan/doan_Dai] : "

- nếu nhập từ bàn phím thí OK.

- nhưng nếu chọn bằng chuột trong danh sách (theo_Phia/doan_Ngan/doan_Dai) thì kết quả lúc nào cũng là P (chọn theo Phia).

Khắc phục: xóa kí tự gạch chân (getkword "\nChon kieu Trim [theoPhia/doanNgan/doanDai] : ") thì OK.

Để không ảnh hưởng đến thiết lập của User, dòng : (setvar "cmdecho" 0) (setvar "osmode" 0) nên đưa xuống trước dòng

(foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ...

Đoạn :

(GetP (vlax-curve-getStartPoint ent0) (vlax-curve-getEndPoint ent0) (/ (HA:LenCur ent0) 2) ent0)

có vẻ như "cởi áo ra rồi lại mặc vào"

Nếu có (command "zoom"... thì nên undo (command "zoom" "P"... sau khi hoàn thành.

Tháng 5 28, 2013

Hướng khác thì có. Nói ở đây là nói cái chuyện sai số thôi, kiểu hay dùng 1E-8 và 1E-9 ấy mà. Sẽ bỏ offset luôn cho nó khỏi lằng nhằng.

Bác Tue_NV có hướng nào tư vấn giùm, code mà có hướng thì chắc làm được.

Hướng dùng lệnh Trim bác ạ. Trim đối tượng bị cắt nào là xong luôn, khỏi phải gom đối tượng rồi đi xét và xử :lol: (như cách làm của bác) . Lằng nhằng ở thằng POLYLINE

Đó là Tue_NV góp ý cho bác thôi, còn tùy bác nhé.

Còn hàm getkword sao bác không thay bằng hàm getpoint kết hợp initget

Khi "getpoint" để pick chọn thì hiểu là chọn phía, còn nhập D thì hiểu là trim cạnh dài, nhập N thì hiểu trim cạnh ngắn. Sẽ tiện hơn đó bác

Tháng 5 28, 2013

-Lisp test trên cad chỉ có zoom lại thôi, không có trim gì hết hok hiểu tại sao.http://www.cadviet.com/upfiles/3/35974_testcad.dwg

Tháng 5 28, 2013

@Gia_bach+Tue_NV: đúng là ngồi ngoài sáng mắt hơn người chơi cờ! Thanks!

1). Sẽ sửa theo 3 góp ý của Gia_bach + 1 góp ý thứ 2 của Tue_NV.

2). Góp ý thứ 1 của Tue_NV: dùng Trim? Khi trim theo phía, nếu đầu mút nó vô cùng ngắn thì làm sao chọn được đầu mút đó để trim phía bên nó? Giải thích giùm chỗ này với?

@Minhtu2004: đang nghiên cứu bản vẽ của bạn, trim bình thường, tuy có 1 sự cố nhỏ.

@All: vừa phát hiện ra là, khi khoảng cách đủ nhỏ thì việc xác định điểm giao nhau có vấn đề >> giải pháp offset để lấy điểm giao cần được xem xét kỹ >> Ai có giải pháp hay về "Trim theo phía" thì xin tư vấn.

Tháng 5 28, 2013

@Gia_bach+Tue_NV: đúng là ngồi ngoài sáng mắt hơn người chơi cờ! Thanks!

1). Sẽ sửa theo 3 góp ý của Gia_bach + 1 góp ý thứ 2 của Tue_NV.

2). Góp ý thứ 1 của Tue_NV: dùng Trim? Khi trim theo phía, nếu đầu mút nó vô cùng ngắn thì làm sao chọn được đầu mút đó để trim phía bên nó? Giải thích giùm chỗ này với?

@Minhtu2004: đang nghiên cứu bản vẽ của bạn, trim bình thường, tuy có 1 sự cố nhỏ.

@All: vừa phát hiện ra là, khi khoảng cách đủ nhỏ thì việc xác định điểm giao nhau có vấn đề >> giải pháp offset để lấy điểm giao cần được xem xét kỹ >> Ai có giải pháp hay về "Trim theo phía" thì xin tư vấn.

Đầu mút của đối tượng trim chính là Startpoint và Entpoint

Quan trọng là thuật giải đó bác.

Hề hề, bác đừng nói Tue_NV ngồi ngoài chớ. Đêm qua, Tue_NV giải xong cái này rồi đó bác. Hẹn chiều nay post lên để bác xem nhé!

Tháng 5 28, 2013

Như đã hẹn, Tue_NV post lisp trim "mở rộng" các đối tượng gồm: Trim theo phía, trim cạnh ngắn của đối tượng, trim cạnh dài của đối tượng. Đường dao cắt là 1 Curve bất kì: Line, Pline, Spline, Arc, Circle, ellipse.

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)
;;write by Tue_NV
  (defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
          (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  )
)
(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach
  (if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))
  (if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))
  (vlax-invoke e1 'IntersectWith e2 flag)
)
(setvar "cmdecho" 0)
  (princ "\nChon cac doi tuong bi cat :")
   (setq sscat (ssget '((0 . "*line,Arc"))))
  (command ".draworder" sscat "" "F")
  (princ "\nChon Dao cat :")
  (setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))
  (sssetfirst nil ssdao)
  (initget "N D")
  (setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))
(if (eq (type pt) 'LIST)
  (foreach x (Tue-ss-list (list sscat))
       (if (Tue-geom-inters
                       (setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));
                      (ssname ssdao 0) 0)
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
        (entdel entps)
   )
 )
(if (= pt "N")
  (foreach x (Tue-ss-list (list sscat))
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
                (/ (vlax-curve-getendparam x) 2.0))
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
      )
   )
 )
 (if (= pt "D")
  (foreach x (Tue-ss-list (list sscat))
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
                (/ (vlax-curve-getendparam x) 2.0))
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
      )
   )
 )
 )

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)

(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

(mapcar 'set '(ssg vlaobj) L-ss-vlaobj)

(setq L (sslength ssg))

(Repeat L

(setq ename (ssname ssg (setq L (1- L))))

(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))

)

(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach

(if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))

(if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))

(vlax-invoke e1 'IntersectWith e2 flag)

)

(setvar "cmdecho" 0)

(princ "\nChon cac doi tuong bi cat :")

(setq sscat (ssget '((0 . "*line,Arc"))))

(command ".draworder" sscat "" "F")

(princ "\nChon Dao cat :")

(setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))

(sssetfirst nil ssdao)

(initget "N D")

(setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))

(if (eq (type pt) 'LIST)

(foreach x (Tue-ss-list (list sscat))

(if (Tue-geom-inters

(setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));

(ssname ssdao 0) 0)

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(entdel entps)

)

(if (= pt "N")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(if (= pt "D")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)

(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

(mapcar 'set '(ssg vlaobj) L-ss-vlaobj)

(setq L (sslength ssg))

(Repeat L

(setq ename (ssname ssg (setq L (1- L))))

(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))

)

(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach

(if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))

(if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))

(vlax-invoke e1 'IntersectWith e2 flag)

)

(setvar "cmdecho" 0)

(princ "\nChon cac doi tuong bi cat :")

(setq sscat (ssget '((0 . "*line,Arc"))))

(command ".draworder" sscat "" "F")

(princ "\nChon Dao cat :")

(setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))

(sssetfirst nil ssdao)

(initget "N D")

(setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))

(if (eq (type pt) 'LIST)

(foreach x (Tue-ss-list (list sscat))

(if (Tue-geom-inters

(setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));

(ssname ssdao 0) 0)

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(entdel entps)

)

(if (= pt "N")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(if (= pt "D")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

Tháng 5 28, 2013

Đâu ngon ăn thế! Test sơ bộ thì thấy cũng cần phải xét các vòi bạch tuộc nó bấu vào end và start nữa chớ?

Tháng 5 28, 2013

Đâu ngon ăn thế! Test sơ bộ thì thấy cũng cần phải xét các vòi bạch tuộc nó bấu vào end và start nữa chớ?

Xét rồi đó bác. "Vòi bạch tuộc" hay "vòi voi" bấu vô chăng nữa Lisp đều xử lý rồi. :lol:

Tháng 5 28, 2013

Tôi test lỗi rồi mà!

Tháng 5 28, 2013

Tôi test lỗi rồi mà!

Bác có thể gửi bản vẽ bác Test không?

Tháng 5 28, 2013

Hình tôi khoanh tròn nhé!

http://www.cadviet.com/upfiles/3/67029_trim_loi.dwg

Tháng 5 28, 2013

-Lisp chạy OK mà, do khi load lisp về nó thêm những ký tự lạ nên bị lỗi phải sửa lại chút la OK.

@Doan Van Ha: Mình đã test file của bạn OK mà.

Đăng nhập

[Đã xong] Lệnh Trim mở rộng

Các bài được khuyến nghị

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.551

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.551

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

minhtu2004 36

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202