Merg polyline

[cuongtk2 348]

 

Dùng để nối thêm dầm vào sàn và ...

 

[CAN.DO 1]

Em có sử dụng một lisp tương tự như của bác
 

(defun c:recunion ( / ss n k fe ss2 ss3 en )
   (setvar 'CMDECHO 0)
   (setq ss (ssget ":L")) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (setq ss2 (ssadd))
   (while (<= 1 n)
            (setq en (ssname ss k))
    (command "region" en "")
    (setq fe (entlast))
            (ssadd fe ss2)
            (setq n (- n 1))
            (setq k (+ k 1))
   )
  (command "union" ss2 "")
  (setq ss3 (ssget "_P" '((0 . "REGION"))))
  (:Region2Polyline ss3)
  (setvar 'CMDECHO 1)
(princ)
); end of defun

(defun c:revunion ( / ss n k fe ss2 ss3 en )
   (setvar 'CMDECHO 0)
   (setq ss (ssget ":L")) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (setq ss2 (ssadd))
   (while (<= 1 n)
            (setq en (ssname ss k))
    (command "region" en "")
    (setq fe (entlast))
            (ssadd fe ss2)
            (setq n (- n 1))
            (setq k (+ k 1))
   )
  (command "union" ss2 "")
  (setq ss3 (ssget "_P" '((0 . "REGION"))))
  (:Region2Polyline ss3)

  (command "revcloud" "s" "n" "o" (entlast) "n" )

  (setvar 'CMDECHO 1)
(princ)
); end of defun

(defun c:Region2Polyline nil
  (if (setq ss (ssget '((0 . "REGION"))))
    (:Region2Polyline ss))
  (princ)
  )

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline (ss / *error* arcbugle acdoc space
             n reg norm expl olst blst dlst plst tlst blg pline)
  
  ;-----
  (defun *error* (msg)
    (if    (/= msg "Function cancelled")
      (princ (strcat "\nError: " msg)))
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    (princ))
  
  ;-----
  (defun arcbulge (arc)
    (/ (sin (/ (vla-get-TotalAngle arc) 4))
       (cos (/ (vla-get-TotalAngle arc) 4))))
  
  ;-----
  ;-----
  
  (setq    acdoc    (vla-get-ActiveDocument (vlax-get-acad-object))
    space    (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace acdoc)
          (vla-get-ModelSpace acdoc)))
  (if ss
    (repeat (setq i (sslength ss))
      (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
        norm (vlax-get reg 'Normal)
        expl (vlax-invoke reg 'Explode))
      (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
                     (= (vla-get-ObjectName x) "AcDbArc")))
            expl)
    (progn
      (vla-delete reg)
      (setq olst (mapcar '(lambda    (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
                 expl))
      (while olst
        (setq blst nil)
        (if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
          (setq blst (list (cons 0 (arcbulge (caar olst))))))
        (setq plst (cdar olst)
          dlst (list (caar olst))
          olst (cdr olst))
        (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
                                 (equal (last plst) (caddr x) 1e-9)))
                olst))
          (if (equal (last plst) (caddar tlst) 1e-9)
        (setq blg -1)
        (setq blg 1))
          (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
        (setq blst (cons (cons (1- (length plst))
                       (* blg (arcbulge (caar tlst)))
                       )
                 blst)))
          (setq plst (append plst
                 (if    (minusp blg)
                   (list (cadar tlst))
                   (list (caddar tlst))))
            dlst (cons (caar tlst) dlst)
            olst (vl-remove (car tlst) olst)))
        (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
                                                 (setq x (trans x 0 Norm))
                                                 (list (car x) (cadr x)))
                                              (reverse (cdr (reverse plst)))))))
        (vla-put-Closed pline :vlax-true)
        (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
        (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
        (vla-put-Normal pline (vlax-3d-point Norm))
        (mapcar 'vla-delete dlst)))
    (mapcar 'vla-delete expl)))
    )
  )
  
 (defun c:revmi ()
  (if (setq ss (ssget))
    (command "revcloud" "s" "n" "o" ss))
  (princ)
) 
  
  
  

[DuongTrungHuy 130]

Mình góp thêm ý về thuật toán giải bài toán này qua các bước:

1.- Cứ mỗi Poly A hãy tìm các đỉnh của các Poly còn lại nằm trên Poly đó.

2.- Sắp xếp các điểm đó kể cả các đỉnh Poly A này theo khoảng cách đến đầu đỉnh poly A.

3.- Bẻ Poly A thành các đoạn thẳng tại các điểm đỉnh và điểm giao trên Poly A.

4.- Hãy chọn các tập đoạn thẳng nào chỉ có 1 mình nó (không chọn đoạn thẳng trùng nhau)

5.- Tạo Poly từ tập đoạn thẳng đó, nó là Poly bao ngoài phải tìm.

 

Chúc thành công!

[cuongtk2 348]

@DuongTrungHuy Nó phức tạp hơn bác nghĩ, khi chọn 4 plyline cùng lúc.

[cuongtk2 348]

Lệnh này có tương tự ở Lee-Mac (C:OutLines) https://lee-mac.com/lisp/html/OutlineObjectsV1-1.html

và Kean Walmsley [CommandMethod("RTP")] https://www.keanw.com/2008/08/creating-a-seri.html

[DuongTrungHuy 130]

3 giờ trước, cuongtk2 đã nói:

@DuongTrungHuy Nó phức tạp hơn bác nghĩ, khi chọn 4 plyline cùng lúc.

Chào Bạn!

Đúng vậy với trường hợp này ta chỉ cần chú ý thêm:

a.- Trhợp Poly lồng bên trong Poly khác: Sau khi đã bẻ ra các Line, trong điều kiện bỏ , ta bỏ thêm các doạn thẳng nằm bên trong 1 Poly khác là được.

b.- Trhợp đối với các miền rời nhau: Sau khi tập hợp thành các LINE để tiến hành ghép nối thành Polyt, thì các LINE tách rời sẽ được tạo thành 1 Poly khác, nghĩa là trong tập Poly ghép được sẽ có nhiều Poly đó Bạn.

 

Bài viết chỉ nhằm để tạo kiến thức lập trình, chứ trong thế giới bao la có thể người ta đã có giải quyết rồi như Bạn đề cập!.

 

Chúc tiến bộ mỗi ngày. Thân ái! 

[cuongtk2 348]

Cảm ơn bác.