Đế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

#41 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 01 June 2013 - 11:37 AM

Khi thực hiện lệnh của lsp mà chọn phía cần trim, thì chọn bên phải thì nó lại trim bên trái là sao nhỉ? 

Thanks!


  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#42 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 01 June 2013 - 11:45 AM

Bạn gởi bản vẽ ấy lên, khoanh vùng trim lại, tôi kiểm tra xem 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.


#43 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 01 June 2013 - 11:49 AM

Đây bạn. mình chọn phía cần trim là bên phải 

http://www.cadviet.c...pfiles/3/68278_


  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#44 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 01 June 2013 - 12:01 PM

Bạn xem bve này nữa nè, khi trim mà trọn bên trái thì nó trim cả cái bên phải và bên trái luôn.

Khi chọn trim đoạn dài thì cũng có lỗi.

http://www.cadviet.c...78_drawingb.dwg


  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#45 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 01 June 2013 - 12:15 PM

Tôi chỉ down được bản thứ 2 còn bản thứ 1 lỗi server. Sửa lisp chút xíu cho nó ổn.

P/S: CadViet bị lỗi up file nên các bạn down về chịu khó delete mấy chữ này trong lisp nhé:  <span> </span>

;http://www.cadviet.com/forum/topic/71578-da-xong-lenh-trim-mo-rong/page-3
;01/6/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.
;3). Trim doan 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 ento lstg lst len1 len2 objlst typ)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode"))
 (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 "N D") (setq typ (getpoint "Pick phia can Trim hoac chon kieu Trim [doanNgan/doanDai] <N>: "))
   (if (not typ) (setq typ "N"))
   (setvar "cmdecho" 0) (setvar "osmode" 0)
   (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))))
   (if (listp typ) 
    (progn
     (command "offset" 1E-8 ent0 typ "")
     (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 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))
       ((listp typ)
        (if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone)
      (entdel ent1)
    (entdel ent2)))))))
   (if ento (entdel ento))))
 (setvar "cmdecho" cmd) (setvar "osmode" osm) (command "zoom" "p") (command "undo" "e") (princ))
(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 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)))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (if (and l (equal (vlax-curve-getClosestPointTo obj2 l nil) l 1E-15))
  (repeat (/ (length l) 3)
   (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l))))
 r)
 


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