Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

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


  • Please log in to reply
44 replies to this topic

#1 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 26 May 2013 - 06:49 PM

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:

67029_trim_mo_rong.png

File Cad để test:

http://www.cadviet.c..._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] <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)
 


  • 9

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 27 May 2013 - 07:18 AM

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.............. 


  • 2

#3 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 May 2013 - 03:41 PM

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


  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 27 May 2013 - 05:07 PM

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.....


  • 0

#5 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 May 2013 - 05:22 PM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 27 May 2013 - 05:26 PM

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.c...4652_test_1.dwg


  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 May 2013 - 06:53 PM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 May 2013 - 06:23 AM

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


  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 May 2013 - 07:01 AM

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:


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 May 2013 - 07:08 AM

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. 


  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 May 2013 - 08:22 AM

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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 28 May 2013 - 08:38 AM

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á.


  • 0

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 May 2013 - 08:52 AM

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

http://www.cadviet.c..._mo_rong_ha.lsp


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 28 May 2013 - 09:31 AM

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] <P>: "

- 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] <P>: ") 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.


  • 1

#15 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 May 2013 - 09:43 AM

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


  • 1

#16 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 28 May 2013 - 09:51 AM

-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.c...974_testcad.dwg


  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#17 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 May 2013 - 10:31 AM

@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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#18 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 May 2013 - 10:40 AM

@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é!


  • 0

#19 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 May 2013 - 02:36 PM

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

  • 1

#20 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 May 2013 - 03:10 PM

Đâ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ớ?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.