* AUTOCAD: LỆNH TRIM 'CHẾ'

đăng 06:24, 8 thg 1, 2016 bởi Manager quyhoach.vn   [ đã cập nhật 22:58, 11 thg 1, 2016 ]
Lời dẫn: Lệnh Trim "chế" chép từ diễn đàn CADViet, hữu ích cho quy hoạch.

Lệnh Trim CAD đặc biệt- làm thế nào để ấn phần dài cắt phần ngắn?

Có phải ý bạn là thế này? 

TRT.gif

Filename: 236126_trt.lsp
(Command: trt)

Lệnh Trim mở rộng

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

<<

Filename: 236232_ha.lsp
(Command: ha)

Lệnh Trim CAD đặc biệt- làm thế nào để ấn phần dài cắt phần ngắn?

........

Tiện đây nhờ các bác viết lisp minh họa bằng hình ảnh sau:114276_%C3%A0af70.png

Hy vọng Lisp này đáp ứng được yêu cầu của "em" Hoằn.

(Chỉ sử dụng với Line và Arc)

(defun C:cut(/ ent ss e pt1 pt2 iPts)
  (command "undo" "be")
  (while
    (not
      (and
	(setq ent (car (entsel "Duong chuan :")))
	(if ent (wcmatch (cdr (assoc 0 (entget ent))) "LINE,ARC,RAY,XLINE" ) ) ) )
    (princ "\nSelect Again: ")    )
  (setq ent (vlax-ename->vla-object ent))
  (princ "\nVat bi cat...")
  (if(setq ss (ssget "_:L" (list (cons 0 "LINE,ARC"))))
    (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq iPts (vlax-Invoke ent "IntersectWith" e 2)
	    ObjName (vla-get-ObjectName e)
	    pt1 (vlax-curve-getStartPoint e)
	    pt2 (vlax-curve-getEndPoint e))
      (if (and iPts (= 3(length iPts) ))
	(cond
	  ((eq ObjName "AcDbLine") ;LINE
	   (if (> (distance iPts pt1)(distance iPts pt2))
	     (vla-put-EndPoint e (vlax-3d-point iPts))
	     (vla-put-StartPoint e (vlax-3d-point iPts)) ) )
	  ((eq ObjName "AcDbArc") ;ARC
	   (setq center (vlax-safearray->list (variant-value (vla-get-Center e))))
	   (if (> (distance iPts pt1)(distance iPts pt2))
	     (vla-put-EndAngle e (vlax-make-variant(angle center iPts)) )
	     (vla-put-StartAngle e (vlax-make-variant(angle center iPts))) ) )   ))))
  (command "undo" "e")(princ)  )

<<

Filename: 236205_cut.lsp
(Command: cut)
https://www.facebook.com/quyhoach.vn/posts/832008800262223


ċ
236126_trt.lsp
(2k)
Manager quyhoach.vn,
18:49, 8 thg 1, 2016
ċ
236205_cut.lsp
(1k)
Manager quyhoach.vn,
18:50, 8 thg 1, 2016
ċ
236232_ha.lsp
(3k)
Manager quyhoach.vn,
18:49, 8 thg 1, 2016