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

#21 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 - 03:16 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ớ?

 

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:


  • 0

#22 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:26 PM

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


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


#23 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 - 03:34 PM

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

 

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


  • 1

#24 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:47 PM

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

http://www.cadviet.c...29_trim_loi.dwg


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


#25 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 - 03:58 PM

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


  • 0

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


#26 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 28 May 2013 - 04:57 PM

@Bác Tuệ : Ket thấy nếu Inters flag bác để 0 thì sẽ có trường hợp Line entmake của bác đi từ pt đến 2 đầu đều thỏa điều kiện k cắt Dao. Vì dù sao thì khái niệm phía vẫn là do mắt định nghĩa, nếu dao bị xoắn quẩy hoặc tự cắt nhau như con giun thì khó hiểu, nên tự quy ước chăng ?

 

Còn Ngắn và Dài hình như Code giống nhau, cho vào 1 được chứ ạ?

Ps : k test được, chém sai mong các bác lượng thứ


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#27 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:31 PM

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

http://www.cadviet.c...29_trim_loi.dwg

 

Tue_NV đã có tính tới "vòi bấu víu không được chọn" mà chưa tính tới "vòi bấu víu" được chọn nên mới xảy ra tình trạng này.

Đã sửa lại code. Bác DVH và các bạn thử xem :

@KetXu: Có TH như bạn nêu. Nên chăng sử dụng Offset dẫn hướng rồi trim. Ý bạn thế nào?

 

 
(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao lst-cat lst-cat2 XYmin XYmax Lx Ly)
;;;;;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)
)
(command "undo" "be")
(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)
  (setq sscat2 (ssadd))
  (foreach x (vl-remove (ssname ssdao 0) (Tue-ss-list (list sscat)))
     (if (Tue-geom-inters x (ssname ssdao 0) 0) 
(setq lst-cat (append lst-cat (list x)))
(setq lst-cat2 (append lst-cat2 (list x)))
    )
  )
(foreach x (Tue-ss-list (list sscat))
(vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp)
(setq LX (append LX (list (car(safearray-value minp)))
   (list (car(safearray-value maxp)))))
(setq LY (append LY (list (cadr(safearray-value minp)))
   (list (cadr(safearray-value maxp)))))
)
   (setq XYmin (list (apply 'min LX) (apply 'min LY) 0.0))
   (setq XYmax (list (apply 'max LX) (apply 'max LY) 0.0))
 
  (initget "N D")
  (setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))
(command "zoom" XYmin XYmax)
(if (eq (type pt) 'LIST)
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
       (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) 
   )
(mapcar 'entdel lst-cat2)
  )
 )
(if (= pt "N")
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
    (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) "")
)
      )
   )
(mapcar 'entdel lst-cat2)
  )
 )
 (if (= pt "D")
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
    (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) "")
)
      )
   )
(mapcar 'entdel lst-cat2)
  )
 )
(command "zoom" "p")
(command "undo" "end")
 )

  • 1

#28 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:05 PM

Test còn lỗi.

Bác Tue_NV có tin tưởng điều này không: ngay cả lệnh Trim và Extrim của Cad nó còn Trim... bậy?

Rồi thêm nữa: 2 đối tượng không giao nhau trực tiếp (nhưng có giao biểu kiến - tức giao khi kéo dài ra) vẫn tồn tại điểm giao nếu dùng osnap intersection hoặc dùng hàm lisp này để xác định: (vlax-invoke obj1 'intersectwith obj2 acExtendNone)

Trên đây là 1 số nguy hiểm đang rình rập nếu bác mong muốn 2 chữ "tuyệt đối" theo hướng "nhỏ bi nhiêu cũng phải trim được".

Vài lời chia sẻ!


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


#29 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 - 11:18 PM

Lisp đã sửa theo các góp ý từ bài #14 đến #16.

P/S: do lỗi của CViet khi post bài nên khi down về dùng các bạn nhớ delete đoạn này đi:  <span> </span>

;28/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.
;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" (* (getvar "viewsize") 1E-6) 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 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.


#30 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 May 2013 - 05:52 AM

Test còn lỗi.

Bác Tue_NV có tin tưởng điều này không: ngay cả lệnh Trim và Extrim của Cad nó còn Trim... bậy?

Rồi thêm nữa: 2 đối tượng không giao nhau trực tiếp (nhưng có giao biểu kiến - tức giao khi kéo dài ra) vẫn tồn tại điểm giao nếu dùng osnap intersection hoặc dùng hàm lisp này để xác định: (vlax-invoke obj1 'intersectwith obj2 acExtendNone)

Trên đây là 1 số nguy hiểm đang rình rập nếu bác mong muốn 2 chữ "tuyệt đối" theo hướng "nhỏ bi nhiêu cũng phải trim được".

Vài lời chia sẻ!

 

1./ Bác nên đưa dẫn chứng minh hoạ. Nói có sách, mách có chứng.....Bác nói không không rứa ai mà tin  :lol:

- Trim của CAD trim bậy?

- 2 đối tượng không giao nhau trực tiếp vẫn tồn tại điểm giao khi dùng (vlax-invoke obj1 'intersectwith obj2 acExtendNone) ?

Phiền bác up file .dwg minh hoạ vậy

 

1 đoạn code viết cần phải hoàn thiện dần mới khắc phục hết lỗi và mới "tuyệt đối" được

Tue_NV không thể đi theo con đường của bác được vì tồn tại 2 nhược điểm đã phân tích

 

P/S: Extrim là lệnh trong bộ Express, không phải lệnh gốc của CAD


  • 0

#31 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 29 May 2013 - 07:00 AM

Bản vẽ đây!

1). Ở chỗ ghi "Inter loi": bác thử osnap + dùng hàm xác định giao điểm 2 line >> tồn tại giao, mặc dầu chúng hở.

2). Ở chỗ ghi "Trim+Extrim loi": bác zoom lớn hết cỡ >> thấy hình tròn >> Trim+Extrim tất cả phần bên ngoài circle xem >> còn lại 1 đoạn không cắt được.

Còn vài phát hiện nữa nhưng đang kiểm chứng.

Chúc bác thành công!

http://www.cadviet.c..._trim_loi_1.dwg


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


#32 gunner1605

gunner1605

    biết pan

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

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

"Toàn các cao thủ , đầu các bác có mủ

Cao thủ quá, quan trọng hoá vấn đề"

Tôi thấy Lisp Trim nào dùng cũng đơ Cad và lỗi luôn. Chưa Trim nào dùng được cả.


  • 0

#33 gunner1605

gunner1605

    biết pan

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

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

Muốn đổi tư thế nên đi tìm luyện tư thế "CHYM ngược".ÔI cái "CHYM ngược" của tôi. các bác vặn " CHYM " của các bác cho ngược lại để em học hỏi cái nào- em không vặn được nên nhờ các bác.


  • 0

#34 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 31 May 2013 - 09:44 AM

Bạn cứ gởi bản vẽ bị lỗi lên, để mọi người có thể test và giúp nếu được. Không ai tài giỏi gì để không mắc lỗi lầm - đó là lý do bút chì có cục gôm bạn ạ.

Bạn dùng những câu văn như thế có nên chẳng?


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


#35 gunner1605

gunner1605

    biết pan

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

Đã gửi 31 May 2013 - 06:14 PM

Câu văn đùa tếu thôi ko có ý gì khác đâu- công việc vất vả nên nói tếu cho không khí đỡ ngột ngạt các bác ợ.


  • 0

#36 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 31 May 2013 - 06:37 PM

Đùa thì được thôi, nhưng sao bạn không gởi bản vẽ lên để test xem nó bị lỗi ở đâu. Thế hay hơn chứ 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.


#37 mrthanhuct

mrthanhuct

    biết pan

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

Đã gửi 31 May 2013 - 10:31 PM

mình có lệnh này góp cùng chủ thớt "extrim" , mình cũng hay vẽ cad nhưng hình như cũng chưa dùng đến trim đoạn dài hay đoạn ngắn :D chỉ là đóng góp ý kiến thôi nhe!


  • 0

#38 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 31 May 2013 - 10:39 PM

1). Chưa thấy có chủ thớt "extrim". Chỉ có thấy chủ thớt "Trim mở rộng".

2). Chúc mừng sự may mắn của bạn là chưa bao giờ đụng đến trim dài hoặc trim ngắn. Mong muốn mãi mãi bạn không gặp nó để phải gặp những phiền toái chẳng đáng 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.


#39 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 - 10:57 AM

Lisp đã sửa theo các góp ý từ bài #14 đến #16.

;28/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.
;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" (* (getvar "viewsize") 1E-6) 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 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)))
 

Mình load lisp này trên cad 2010 thì báo lỗi này:

Command: ; error: syntax error

Mr Ha xem là lỗi gì vậy?

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


#40 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:15 AM

CViet hay bị lỗi khi up code lisp. Nếu tôi edit code lisp thì nó sẽ bị lỗi tiếp >> Các bạn down lisp về (bài #29), nhớ delete đoạn  <span> </span> là OK thôi. Chỉ delete chừng đó thôi, đừng delete cả dòng nhé.


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