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

[ketxu 2.984]

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

[Tue_NV 3.912]

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

http://www.cadviet.com/upfiles/3/67029_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")
 )

[Doan Van Ha 3.202]

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ẻ!

[Doan Van Ha 3.202]

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

 

[Tue_NV 3.912]

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

[Doan Van Ha 3.202]

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.com/upfiles/3/67029_trim_loi_1.dwg

[gunner1605 1]

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

[gunner1605 1]

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.

[Doan Van Ha 3.202]

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?

[gunner1605 1]

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

[Doan Van Ha 3.202]

Đù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ỉ?

[mrthanhuct 0]

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!

[Doan Van Ha 3.202]

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

[nguyentienthanhddksct 6]

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!

[Doan Van Ha 3.202]

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

[nguyentienthanhddksct 6]

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!

[Doan Van Ha 3.202]

Bạn gởi bản vẽ ấy lên, khoanh vùng trim lại, tôi kiểm tra xem nhé!

[nguyentienthanhddksct 6]

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

http://www.cadviet.com/upfiles/3/68278_

[nguyentienthanhddksct 6]

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.com/upfiles/3/68278_drawingb.dwg

[Doan Van Ha 3.202]

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)