Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
TuanDat2023

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

Các bài được khuyến nghị

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
36 phút trước, limfx đã nói:

image.png.d3890f22ba60a367ed1522cddcd725c3.png

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 @@ image.png.5840610315aca303dba23c5588045ed7.png

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

để 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 image.thumb.png.f7dee712395d643e98a70502630261d5.png

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 

image.png.e6a970d79437616cc0dde6c2c662769a.png

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

 

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×