Chuyển đến nội dung
Diễn đàn CADViet
phongtran86

[yêu cầu &thảo luận] lisp vẽ mặt bằng kết cấu

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

E xin chân thành cảm ơn bác, bác làm được thế này đã là quá tuyệt vời đối với e rùi, bác cho e hỏi thêm với, hình như cái Code bây giờ nó dài gấp 3 lần trước hả bác ???

Dài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.

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

Hic, bác ơi, bác giúp e xóa bớt đoạn không cần thiết nhìn cho gọn được không ạ, vì e cảm giác nó hơi nặng khi e chạy bác ạ, mà máy e thì thuộc dạng cùi bắp !E cảm ơn !

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

Hic, bác ơi, bác giúp e xóa bớt đoạn không cần thiết nhìn cho gọn được không ạ, vì e cảm giác nó hơi nặng khi e chạy bác ạ, mà máy e thì thuộc dạng cùi bắp !E cảm ơn !

Không liên quan gì những điều bạn nói cả. Kệ nó.

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ài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.

Bác "Doan Van Ha" ơi, e vừa sử dụng Lisp vẽ Mặt bằng kết cấu này thì lại bị lỗi bác à, với một số mặt bằng vẽ thì không sao, nhưng đến mặt bằng này thì lại phát sinh lỗi, mà mặt bằng tim trục này thuộc lại đơn giản, không phức tạp, e gửi lại Lisp lần trước bác Update lần cuối với File Cad mà e check bị lỗi không tạo được mặt bằng dầm bác xem lại giúp e với nhé !

e xin chân thành cảm ơn, nhân tiện nếu Lisp này có thể rút gọn được thì bác rút gọn giúp e với bác nhé !

Chúc bác sức khỏe và sự thành công !

Hic, e đính kèm File mà không được, bác vào tạm Mediafire nhé !

 

http://www.mediafire.com/download/i747bczg72cnol7/Check.rar

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ài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.

Bác Doan Van Ha" ơi vào giúp e với, Lisp này vẫn bị lỗi bác ợ !!!

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

Trục phức tạp làm được, trục đơn giản không làm được :( ... chẳng lẻ đấy là lỗi "oái oăm" trong LISP :wub:

Nó không oái oăm đâu. Ngay đầu lisp tôi đã ghi chú "ô ngoài cùng phải là hình chữ nhật". Bạn xem lại 4 Line ngoài cùng, nó không tạo thành hình chữ nhật (kiểm tra X và Y của các đầu mút line sẽ thấy).

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

Lấy ý tưởng từ bài

http://www.cadviet.com/forum/topic/93584-nho-viet-lisp-hatch-vung-kin-cua-cac-doi-tuong-giao-nhau/

Tôi sửa lại lisp của bạn Doan Van Ha như sau:

- Sửa hàm chính: MBCK

- Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là "N"

- Các hàm khác như cũ.

Các bạn check xem còn lỗi nào không

 

(defun SsNext (e f / ss)
    (setq ss (ssadd))
    (while (setq e (entnext e))
        (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss))    )
)
(defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy)
 (command "undo" "be") (redraw)
    (setq sy '("CMDECHO" "OSMODE" "PEDITACCEPT" "DELOBJ") sv (mapcar 'getvar sy))
    (mapcar 'setvar sy '(0 0 1 1))
 (setq col 1)
 (while
  (and
   (princ "\nChon cac Line duong truc...")
   (setq ss (ssget '((0 . "LINE"))))
   (setq lsti (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (or kc (setq kc 110))
   (setq kc (cond ((getdist (strcat "\nBe rong tuong/dam <" (rtos kc 2 2) ">:"))) (kc))))
  (mapcar '(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) col)) lsti)
  (setq lst (append (mapcar '(lambda(ent) (list ent kc)) lsti) lst))
  (setq lstb (append lsti lstb))
  (setq col (1+ col)))
 (command "zoom" "w" (car (setq c (LM:ListBoundingBox lstb))) (cadr c))
 (setq lst (reverse lst))
    (setq ll (entlast))
 (foreach n1 lst
  (setq lstg1 nil)
  (foreach n2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object (car n1)) (vlax-ename->vla-object (car n2)) acExtendNone)))
    (setq lstg1 (cons giao lstg1)))
        )
     (if lstg1
         (progn
             (setq i 0 o (cdr (assoc 10 (entget (car n1)))))
             (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 '(lambda(p q) (< (distance p o) (distance q o)) ))1e-10))
             (repeat (1- (length lstg1))
                 (entmake (list (cons 0 "LINE") (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) ))         )
         )
    ))
 ;(load "overkillsup.lsp")
    (vl-cmdf "._REGION" (SsNext ll nil) "")
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "REGION"))))
        (vl-cmdf "._EXPLODE" ent)
        ;(acet-overkill2 (list (ssget "P") 1E-3))
        (vl-cmdf "PEDIT" "M" "p" "" "J" "" "" )
        )
    
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "LWPOLYLINE")))))
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
 (HA:OffsetInOut (car ss) lst "N")
 (foreach ent (cdr ss)
  (HA:OffsetInOut ent lst "T"))
    (mapcar 'setvar sy sv)(command "undo" "e")
    (redraw) (princ))

(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-1))
       obj2 (car (vlax-invoke obj 'Offset -1E-1)))
 (if (> (vla-get-area obj1)(vla-get-area obj2))
  (setq lon obj1 nho obj2)
  (setq lon obj2 nho obj1))
 (if (> (distance p (vlax-curve-getClosestPointTo lon p))(distance p (vlax-curve-getClosestPointTo nho p)))
  (if (= flag "T")(setq flag1 T))
     (if (= flag "N")(setq flag1 T)
   ))
 (mapcar 'vla-delete (list lon nho))
 flag1)
 
  • Vote tăng 2
  • Vote giảm 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

 

Lấy ý tưởng từ bài

http://www.cadviet.com/forum/topic/93584-nho-viet-lisp-hatch-vung-kin-cua-cac-doi-tuong-giao-nhau/

Tôi sửa lại lisp của bạn Doan Van Ha như sau:

- Sửa hàm chính: MBCK

- Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là "N"

- Các hàm khác như cũ.

Các bạn check xem còn lỗi nào không

 

(defun SsNext (e f / ss)
    (setq ss (ssadd))
    (while (setq e (entnext e))
        (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss))    )
)
(defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy)
 (command "undo" "be") (redraw)
    (setq sy '("CMDECHO" "OSMODE" "PEDITACCEPT" "DELOBJ") sv (mapcar 'getvar sy))
    (mapcar 'setvar sy '(0 0 1 1))
 (setq col 1)
 (while
  (and
   (princ "\nChon cac Line duong truc...")
   (setq ss (ssget '((0 . "LINE"))))
   (setq lsti (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (or kc (setq kc 110))
   (setq kc (cond ((getdist (strcat "\nBe rong tuong/dam <" (rtos kc 2 2) ">:"))) (kc))))
  (mapcar '(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) col)) lsti)
  (setq lst (append (mapcar '(lambda(ent) (list ent kc)) lsti) lst))
  (setq lstb (append lsti lstb))
  (setq col (1+ col)))
 (command "zoom" "w" (car (setq c (LM:ListBoundingBox lstb))) (cadr c))
 (setq lst (reverse lst))
    (setq ll (entlast))
 (foreach n1 lst
  (setq lstg1 nil)
  (foreach n2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object (car n1)) (vlax-ename->vla-object (car n2)) acExtendNone)))
    (setq lstg1 (cons giao lstg1)))
        )
     (if lstg1
         (progn
             (setq i 0 o (cdr (assoc 10 (entget (car n1)))))
             (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 '(lambda(p q) (< (distance p o) (distance q o)) ))1e-10))
             (repeat (1- (length lstg1))
                 (entmake (list (cons 0 "LINE") (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) ))         )
         )
    ))
 ;(load "overkillsup.lsp")
    (vl-cmdf "._REGION" (SsNext ll nil) "")
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "REGION"))))
        (vl-cmdf "._EXPLODE" ent)
        ;(acet-overkill2 (list (ssget "P") 1E-3))
        (vl-cmdf "PEDIT" "M" "p" "" "J" "" "" )
        )
    
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "LWPOLYLINE")))))
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
 (HA:OffsetInOut (car ss) lst "N")
 (foreach ent (cdr ss)
  (HA:OffsetInOut ent lst "T"))
    (mapcar 'setvar sy sv)(command "undo" "e")
    (redraw) (princ))

(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-1))
       obj2 (car (vlax-invoke obj 'Offset -1E-1)))
 (if (> (vla-get-area obj1)(vla-get-area obj2))
  (setq lon obj1 nho obj2)
  (setq lon obj2 nho obj1))
 (if (> (distance p (vlax-curve-getClosestPointTo lon p))(distance p (vlax-curve-getClosestPointTo nho p)))
  (if (= flag "T")(setq flag1 T))
     (if (= flag "N")(setq flag1 T)
   ))
 (mapcar 'vla-delete (list lon nho))
 flag1)
 

cảm ơn bạn đoàn văn hà đã viết code và bạn đã có công phát triển hoàn thiện tiếp, bạn nghĩ sao nếu phát triển trục dầm là đường cong  :D

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

error: no function definition: LM:LISTBOUNDINGBOX

Hôm trc dùng ok. hôm nay ko bik sao cứ bị lỗi nhu trên.

lisp bị lỗi do 1 số hàm cũ file trc bác không copy lại. copy lại là dc. :D
Lisp này bị 1 lỗi nữa là nếu mà chỉ 2 trục ngang, 2 trục đứng thì vẽ bị lỗi. 3 trục trở lên mới k bị lỗi. Nếu được phiền bạn chỉnh lại giúp :)

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

error: no function definition: LM:LISTBOUNDINGBOX

Hôm trc dùng ok. hôm nay ko bik sao cứ bị lỗi nhu trên.

lisp bị lỗi do 1 số hàm cũ file trc bác không copy lại. copy lại là dc. :D

Lisp này bị 1 lỗi nữa là nếu mà chỉ 2 trục ngang, 2 trục đứng thì vẽ bị lỗi. 3 trục trở lên mới k bị lỗi. Nếu được phiền bạn chỉnh lại giúp :)

Nếu lần trước bạn không bị lỗi, đó là do "ơn giời, cậu có rồi!", vì hàm LM:LISTBOUNDINGBOX chưa có sẵn, nhưng chẳng may bạn đã load 1 lisp có hàm đó trước khi dùng lsp của ndtnv. Còn lần này, vì hàm trên chưa được load. Chắc vậy?

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

Nếu lần trước bạn không bị lỗi, đó là do "ơn giời, cậu có rồi!", vì hàm LM:LISTBOUNDINGBOX chưa có sẵn, nhưng chẳng may bạn đã load 1 lisp có hàm đó trước khi dùng lsp của ndtnv. Còn lần này, vì hàm trên chưa được load. Chắc vậy?

chính xác. em vẫn còn lisp cũ của anh chạy trc mà, nó không lỗi. không load cung nó lỗi ngay. em copy lại dc rồi  LM:LISTBOUNDINGBOX và 1 số hàm khác. nó chạy vào vèo rồi.

Còn lỗi thứ 2: ndtnv chỉnh hàm  mà bjo hàm không vẽ được 4 đối tượng trục hay sao ý (2 trục đứng +2 trục ngang). 5 trở lên thì được :D. Hàm trước của bác Hà thì đc. Bác mà ghé qua được fix dùm em với. Thanks bác

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

Sửa

(setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))

thành

 

    (if (= (length ss) 1)
        (progn
            (vla-copy (vlax-ename->vla-object (car ss))  )
            (setq ss (cons (entlast) ss))
        )
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
        )

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

EM mới tập dùng lisp. Không hiểu sao em gõ ap rồi add lisp bác Hà vào mà gõ lệnh ha =>enter mà cad không chạy được. Em đã thử khởi động lại Cad vẫn không được. Có phải lisp này dùng cho Cad đời cao hơn không? Em xài Cad 2007.

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


×