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ị

Anh Hà ơi em hỏi chút: Select objects:
Be rong tuong/dam <110.00>:
Chon cac Line duong truc...
Select objects:  ; error: bad argument type: lselsetp nil

Một số trục khi em copy của ktruc để vẽ nó bị lỗi thế va ko hiện bản vẽ dầm. Lỗi do đâu. Copy riêng trục sang bản vẽ khác vẫn bị lỗi trê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

1). Bạn kiểm tra và xoá 1 line trùng trong hình của bạn đi nhé.

2). Mình bổ sung thêm tí xíu cho lisp chạy nhanh hơn. Mình không ngờ khi zoom bé thì lisp chạy cực chậm như bản vẽ của bạn.


 

;Doan Van Ha - CADViet.com - Ngay 25/05/2013
;Chuc nang: ve luoi dam/tuong theo he truc // XOY, be rong tuy chon, luoi break bat ky nhung o ngoai cung phai la HCN.
(defun C:HA(/ ss lsti lst lstg1 giao lstg kcm ptx pty ent col lstb)
 (vl-load-com) (command "undo" "be") (redraw)
 (setq cmd (getvar "cmdecho") osm (getvar "osmode") hpb (getvar "hpbound")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "hpbound" 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))
 (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 (setq lstg (append lstg1 lstg))))
 (setq lstg (LM:UniqueFuzz (vl-sort lstg '(lambda(p q) (if (equal (car p) (car q) 1E-3) (< (cadr p) (cadr q)) (< (car p) (car q))))) 1E-3))
 (HA:hcn (car lstg) (last lstg) 0)
 (setq a lstg)
 (HA:OffsetInOut (entlast) lst "N")
 (setq kcm (* 0.9 (HA:DisMinMax lstg "min")))
 (setq ss (ssadd) ptx (polar (car lstg) 0 kcm))
 (while (< (car ptx) (car (last lstg)))
  (setq pty (polar ptx (/ pi 2) kcm))
  (while (< (cadr pty) (cadr (last lstg)))
   (setq ent (entlast))
   (command "boundary" pty "")
   (if (setq ent (entnext ent)) (setq ss (ssadd ent ss)))
   (setq pty (polar pty (/ pi 2) kcm)))
  (setq ptx (polar ptx 0 kcm)))
 (load "overkillsup.lsp") (acet-overkill2 (list ss 1E-3 nil "N" "N" "N"))
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "w" (car lstg) (last lstg) '((0 . "LWPOLYLINE"))))))
  (HA:OffsetInOut ent lst "T"))
 (acet-overkill2 (list (ssget "w" (car lstg) (last lstg) '((0 . "LWPOLYLINE"))) 1E-3 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (setvar "osmode" osm) (command "undo" "e") (redraw) (princ))
;-----
(defun LM:ListBoundingBox ( entlst / l1 l2 ll ur )
 (foreach ent entlst
  (setq obj (vlax-ename->vla-object ent))
  (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)))
;----- Check xem 2 lines ent1 vµ ent2 n»m trªn cïng ®­êng th¼ng kh«ng?
(defun HA:2LineCollinear-p(ent1 ent2)
 (setq p1 (vlax-curve-getStartPoint ent1) p2 (vlax-curve-getEndPoint ent1)
       q1 (vlax-curve-getStartPoint ent2) q2 (vlax-curve-getEndPoint ent2))
 (and
  ((lambda(a b c) (or (equal (+ a b) c 1E-3) (equal (+ b c) a 1E-3) (equal (+ c a) b 1E-3))) (distance p1 p2) (distance p2 q1) (distance q1 p1))
  ((lambda(a b c) (or (equal (+ a b) c 1E-3) (equal (+ b c) a 1E-3) (equal (+ c a) b 1E-3))) (distance p1 p2) (distance p2 q2) (distance q2 p1))))
;----- Check xem ®iÓm p co n»m trong/ngoµi obj kin hay kh«ng?
(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-3))
       obj2 (car (vlax-invoke obj 'Offset -1E-3)))
 (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)))
 (mapcar 'vla-delete (list lon nho))
 flag1)
;----- Offset ent vµo bªn trong polygon, víi dis mçi c¹nh kh¸c nhau.
(defun HA:OffsetInOut(ent lstx flag / obj0 obj obj1 obj2 i mid objc objl lst lst1 lst2 lst3 lst4)
 (setq obj0 (vlax-ename->vla-object ent))
 (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget ent))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "cp" lst '((0 . "LINE")))))))
 (setq lst1 (append lst lst))
 (setq i 0)
 (repeat (length lst)
  (setq obj (vlax-ename->vla-object (setq ent1 (entmakex (list (cons 0 "LINE") (cons 10 (nth i lst1)) (cons 11 (nth (1+ i) lst1)))))))
  (foreach ent2 entlst
   (if (HA:2LineCollinear-p ent1 ent2) (setq entL ent2)))
  (foreach ent lstx
   (if (equal entL (car ent)) (setq kcx (cadr ent))))
  (setq obj1 (car (vlax-invoke obj 'Offset (/ kcx 2))) obj2 (car (vlax-invoke obj 'Offset (/ kcx -2))))
  (setq mid (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-curve-getStartPoint obj1) (vlax-curve-getEndPoint obj1)))
  (if (HA:PointInOut mid obj0 flag)
   (setq objc obj1 objl obj2)
   (setq objc obj2 objl obj1))
  (setq lst2 (cons objc lst2))
  (mapcar 'vla-delete (list objl obj))
  (setq i (1+ i)))
 (setq lst3 (append lst2 lst2))
 (setq i 0)
 (repeat (length lst2)
  (if (setq giao (HA:Giao (nth i lst3) (nth (1+ i) lst3) acExtendBoth))
   (setq lst4 (cons (car giao) lst4)))
  (setq i (1+ i)))
 (LWPoly lst4 1)
 (mapcar 'vla-delete (cons obj0 lst2)))
(defun LWPoly(lst cls)
 (entmakex (append (list 
    (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
(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 HA:hcn(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" p1x p3x))
(defun LM:UniqueFuzz(l fz)
 (if l 
  (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda(x) (equal x (car l) fz)) (cdr l)) fz))))
(defun HA:DisMinMax(lst func / ghan)
 (if (= (strcase func) "MIN") (setq func min ghan 1E15) (setq func max ghan -1E15))
 (apply 'func (apply 'append (mapcar '(lambda(p) (mapcar '(lambda(q) (if (equal p q 1E-3) ghan (distance p q))) lst)) 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

Tốt rồi. :) Giờ anh fix cả lỗi đường trùng nhau rồi. vẫn cái mb líp mới chạy phe phé. líp cũ đơ như cây cơ :))

Ah Nhầm anh ơi. cái đường trung nhau là do dùng lisp cũ sinh ra. nó ko tạo ra dầm mà chỉ tạo ra mỗi 1 đường đấy. Không biết anh fix lỗi gì mà hay thế. he he :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

3202_mbkc.jpghic

 

 

Hôm trước chạy ngon lành, bây giờ xuất hiện cái bảng này. kể cả khi tạo bản vẽ mới cũng bị

 

Bạn có thể không dùng grdraw để đánh dấu các line đã được chọn, vì trong quá trình chọn mà pan đi thì các grdraw sẽ mất mất hết.

Thay vào đó vẽ các line, sau khi kết thúc chọn thì xóa các line này đi (chưa tính đến việc ESC trong quá trình chọn, nếu được thì Bạn bẫy lỗi luôn để nó trả về như trước khi chọ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

1). Bạn sửa như thế này chắc hết xuất hiện dialog phụ.

(command "boundary" pty "")

Thành

(command ".-boundary" pty "")

2). Chức năng đánh dấu này không quan trọng lắm nên mình dùng grdraw cho đơn giản, nhưng nhược điểm là biến mất khi zoom >> nếu cần thiết thì lúc nào rảnh sẽ thay bằng các line tạm và bẫy lỗi đàng hoàng.

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

a HÀ cho e cái hướng dẫn sử dụng ,khi e dùng xong lệnh sao khoảng cách của tường chỉ có 1 nửa vậy ,e nhập 800 mà khoảng cách chỉ có 400. thank a nhiều .^^

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). Bạn sửa như thế này chắc hết xuất hiện dialog phụ.

(command "boundary" pty "")

Thành

(command ".-boundary" pty "")

Nhân tiện cho hỏi là có biến hệ thống nào ảnh hưởng đến cách viết lệnh bên trên không. Vì nhiều lúc viết thì người này dùng được người khác không dùng được, khi đó phải đi sửa cho từng người thì mệt quá (người sử dụng không biết về lisp)

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ình vừa cài cad 2014. chạy lisp này lại lỗi.

Select objects:
Be rong tuong/dam <110>:
Chon cac Line duong truc...
Select objects:  ; error: LOAD failed: "overkillsup.lsp"

Hình như trong express tool cua cad 2014 bỏ mất cái này rồi hay sao ấ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

Bạn sửa:

"overkillsup.lsp"

Thành:

"overkillsup"

Mình không có cad2014 nên không test được. Nếu không được nữa thì đành bó tay.

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

cad mới lệnh overkill nó ko phải líp cúa express nữa, mình lấy líp này trong express tôl 2007 copy vào, lại chạy ngon ơ :D. Mình chạy song song 2 cad nên làm cách đấ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

Bác "Doan Van Ha" ơi, sao e làm theo cái Lisp này để vẽ mặt bằng dầm mà nó bị lỗi bác ợ, bác để ý trên cái hình e đính kèm ý, chỗ 2 cái trục chéo, nó bị mất hẳn 1 bên của nét dầm, chỗ 2 tam giác e khoanh tròn ý ạ, mong bác sớm khắc phục giúp anh em với nha ! Chúc bác mạnh khỏe ! Thanks bác nhìu ! :), e quên mất còn 1 điều nữa, đó là mỗi khi sử dụng lisp này thì ta lại phải định nghĩa lại những điểm cần bắt như bắt điểm giao, bắt điểm song song, vuông góc ... hình như gọi là Osnap ý ợ, bác khắc phục luôn giúp cho e với nhé !

 

10033_dam_bi_loi.jpg

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 Ha ơi, bác vào giúp cho e với, cái lisp này mà hoàn thiện thì tốt quá bác ạ, e thấy ở các bài Comment trước bác đã Fix lỗi bị mất bắt điểm Snap, mà sao mỗi khi e dùng lệnh "HA" thì vẫn bị mất bắt điểm bác ợ, lại phải chọn bắt điểm lại, bác giúp sửa lisp cho anh em với bác nhá ! :blush:

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

Vâng, e gửi kèm theo bản vẽ bên dưới, mong bác kiên nhẫn giúp cho e với ạ, có 3 vấn đề mà e thắc mắc:

1. Mỗi khi dùng lệnh "HA" thì lại bị mất hết bắt điểm, ta phải chọn lại !

2. Tại chỗ các trục chéo thường xuyên bị xảy ra lỗi mất nét dầm !

3. Với các trục hình bán nguyệt để vẽ dầm cong thì không chọn được trục cong !

E mong bác kiên nhẫn giúp bọn e khắc phục các nhược điểm trên bác nhé, e xin chân thành cảm ơn bác, chúc bác mạnh khỏe để có thể cống hiến nhiều hơn cho diễn đàn !

http://www.cadviet.com/upfiles/3/10033_check_lisp_mbkc.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

Vâng, e gửi kèm theo bản vẽ bên dưới, mong bác kiên nhẫn giúp cho e với ạ, có 3 vấn đề mà e thắc mắc:

1. Mỗi khi dùng lệnh "HA" thì lại bị mất hết bắt điểm, ta phải chọn lại !

2. Tại chỗ các trục chéo thường xuyên bị xảy ra lỗi mất nét dầm !

3. Với các trục hình bán nguyệt để vẽ dầm cong thì không chọn được trục cong !

E mong bác kiên nhẫn giúp bọn e khắc phục các nhược điểm trên bác nhé, e xin chân thành cảm ơn bác, chúc bác mạnh khỏe để có thể cống hiến nhiều hơn cho diễn đàn !

http://www.cadviet.com/upfiles/3/10033_check_lisp_mbkc.dwg

Tôi chỉ đủ sức 2 trong 3 điều bạn y/c mà thôi:

1). Như đã nói từ đầu là lisp không thể vẽ cho dạng đường trục bất kỳ như bán nguyệt, tròn, zích zắc... Nó chỉ chơi với các ô chữ nhật, tam giác, hình thang thôi.

Tôi không đủ sức để mở rộng cho mọi kiểu ô. Thông cảm nhé!

2). Vì vậy, bạn phải loại các đường trục đặc biệt ấy ra khi chạy lisp. Khi đó osnap sẽ không bị mất.

Bạn down lại ở đây:

http://www.cadviet.com/upfiles/3/67029_draw_grip_truc_tuong_ha.lsp

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

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

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


×