(nhờ giúp đỡ) Nhờ các cao nhân tạo lisp bao quanh các đường line

[TuanDat2023 3]

Tình hình em có 1 bản vẽ có các đường line như này. Lúc e tạo lệnh Bo thì các đường bao nó bị trùng nhiều đối tượng với nhau, các bác có cách nào khắc phục hộ e với ạ. Em xin cảm ơn, em gửi các bác bản vẽ kèm theo. Đường màu đỏ là đường bao bị lỗi nhiều line trùng nhau trên đường bao

taoduongbao.dwg

[limfx 33]

Chưa hiểu ý bạn?

[TuanDat2023 3]

36 phút trước, limfx đã nói:

Chưa hiểu ý bạn?

bác x cái đường đỏ đường bao mà tạo ra ý bác, nó có những cái đường line mà gần nhau gây lỗi

[tannguyen291 167]

Nếu từ nét LINE màu trắng thành nét bao màu đỏ thì có cái convexhull của lee mac. khá oke đó. nhưng lisp chạy hơi lâu.

https://lee-mac.com/convexhull.html

[TuanDat2023 3]

Nó tạo ra các đường như này bác, chứ không phải 1 đường pline liền mạch 

[TuanDat2023 3]

7 phút trước, tannguyen291 đã nói:

Nếu từ nét LINE màu trắng thành nét bao màu đỏ thì có cái convexhull của lee mac. khá oke đó. nhưng lisp chạy hơi lâu.

https://lee-mac.com/convexhull.html

e test nhưng không thấy nó vẽ đc bác ạ

[tannguyen291 167]

tải lisp convexhull về rồi thêm đoạn mã này nữa mới chạy được 

(defun c:test (/ ss lst )
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "LINE"))))
    lst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x)))) ) ss)
    lst (LM:ConvexHull (apply 'append lst))
  )
  (entmakex
      (append
          (list
             '(000 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
              (cons 90 (length lst))
             '(070 . 1)
          )
          (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
      )
  )
)

 

[TuanDat2023 3]

3 phút trước, tannguyen291 đã nói:

tải lisp convexhull về rồi thêm đoạn mã này nữa mới chạy được 

(defun c:test (/ ss lst )
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "LINE"))))
    lst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x)))) ) ss)
    lst (LM:ConvexHull (apply 'append lst))
  )
  (entmakex
      (append
          (list
             '(000 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
              (cons 90 (length lst))
             '(070 . 1)
          )
          (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
      )
  )
)

 

nó tạo ra được đường màu xanh này , e muốn nó tạo ra cái đường màu đó viền trong này ấy bác, màu xanh là nó nối các đỉnh của line thì nó vẽ đc, còn màu đỏ bên trong  k có cách nào @@ 

[TuanDat2023 3]

để dễ hiểu hơn em xin mô tả, cái đường đỏ bên trong kiểu như vẽ nối mép ngoài cùng của các đường line , gặp đình thì nó vẽ vào đỉnh như này các bác 

Lúc mà e tạo BO thì cái đường tạo ra nó có nhiều đường con song song như này, chắc do các đường màu trắng quá dày nó không hiểu 

 

[tannguyen291 167]

mã này có thể chạy được với các hình dạng giống bản vẽ. chữa rõ với các hình dạng khác hoạt động được đến đâu :((

(defun c:test (/ sel ss lst eng pt ntx ang lstss )
  (setq 
    sel (ssget '((0 . "LINE")))
    ss (acet-ss-to-list sel)
    pt (getpoint "\nStart Point:")
    lst (mapcar 
          '(lambda (x / a b) 
             (setq
               a (cdr (assoc 10 (entget x))) 
               b (cdr (assoc 11 (entget x)))
             )
             (if (< (distance a pt) (distance b pt)) a b)
           )
          ss
        )
    ntx (car (vl-sort-i lst '(lambda (a b) (< (distance a pt) (distance b pt)))))
    ptx (if (eq (nth ntx lst) (cdr (assoc 10 (entget (nth ntx ss)))))
          (cdr (assoc 11 (entget (nth ntx ss))))
          (cdr (assoc 10 (entget (nth ntx ss))))
        )
    ss (list (nth ntx ss))
    lst (list (nth ntx lst))
    ang (angle (car lst) ptx)
  )
  (acet-ss-zoom-extents sel)
  (while (and
           (setq lstss (ssget "F" (list (car lst) ptx )'((0 . "LINE"))))
           (setq lstss (acet-ss-to-list lstss))
           (setq lstss (vl-remove-if '(lambda (x) (member x ss)) lstss))
         )
    (setq 
      eng (list (cdr (assoc 10 (entget (car lstss)))) (cdr (assoc 11 (entget (car lstss)))))
      ntx (inters ptx (car lst) (car eng) (cadr eng) nil)
      ss (cons (car lstss) ss)
      lst (cons ntx lst)
    )
    (if (minusp (cos (- (angle ntx (car eng)) ang)))
      (setq ptx (cadr eng))
      (setq ptx (car eng))
    )
    (setq ang (angle (car lst) ptx))
  )
  (setq lst (reverse (cons ptx lst)))
  (entmakex
      (append
          (list
             '(000 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
              (cons 90 (length lst))
             '(070 . 1)
          )
          (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
      )
  )
  (princ)
)

 

[TuanDat2023 3]

1 giờ} trướ}c, tannguyen291 đã nói:

mã này có thể chạy được với các hình dạng giống bản vẽ. chữa rõ với các hình dạng khác hoạt động được đến đâu :((

(defun c:test (/ sel ss lst eng pt ntx ang lstss )
  (setq 
    sel (ssget '((0 . "LINE")))
    ss (acet-ss-to-list sel)
    pt (getpoint "\nStart Point:")
    lst (mapcar 
          '(lambda (x / a b) 
             (setq
               a (cdr (assoc 10 (entget x))) 
               b (cdr (assoc 11 (entget x)))
             )
             (if (< (distance a pt) (distance b pt)) a b)
           )
          ss
        )
    ntx (car (vl-sort-i lst '(lambda (a b) (< (distance a pt) (distance b pt)))))
    ptx (if (eq (nth ntx lst) (cdr (assoc 10 (entget (nth ntx ss)))))
          (cdr (assoc 11 (entget (nth ntx ss))))
          (cdr (assoc 10 (entget (nth ntx ss))))
        )
    ss (list (nth ntx ss))
    lst (list (nth ntx lst))
    ang (angle (car lst) ptx)
  )
  (acet-ss-zoom-extents sel)
  (while (and
           (setq lstss (ssget "F" (list (car lst) ptx )'((0 . "LINE"))))
           (setq lstss (acet-ss-to-list lstss))
           (setq lstss (vl-remove-if '(lambda (x) (member x ss)) lstss))
         )
    (setq 
      eng (list (cdr (assoc 10 (entget (car lstss)))) (cdr (assoc 11 (entget (car lstss)))))
      ntx (inters ptx (car lst) (car eng) (cadr eng) nil)
      ss (cons (car lstss) ss)
      lst (cons ntx lst)
    )
    (if (minusp (cos (- (angle ntx (car eng)) ang)))
      (setq ptx (cadr eng))
      (setq ptx (car eng))
    )
    (setq ang (angle (car lst) ptx))
  )
  (setq lst (reverse (cons ptx lst)))
  (entmakex
      (append
          (list
             '(000 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
              (cons 90 (length lst))
             '(070 . 1)
          )
          (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
      )
  )
  (princ)
)

 

vâng, e có nhiều đường nó khùm khoằm nhiều hướng, có gì em nghiên cứu thêm