Viết lisp theo yêu cầu [phần 2]

[ketxu 2984]

Cái này @bác Sì trít, vừa mới có rì quét mấy hôm thì phải

 

;; free lisp from cadviet.com

;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] "))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
'(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
(> (cadr x1) (cadr y1)) ((prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if ((- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(> (cadr x2) (cadr y2)) ((setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
( (car x2) (car y2))))))
))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil) 
(progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
'(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
(> (cadr x3) (cadr y3)) ((if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
);progn
);if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while ((if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru") (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
(progn
(if ((- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1)))))) 
(setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
(setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
(command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
(command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
);progn
(entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol) 
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)

[thanhvienmoi1981 0]

Cám ơn bác PhamvanThiet108 nhiều, chúc bác và các bác trên diễn đàn năm mới vui vẻ hạnh phúc thành đạt nhé

:undecided:

[ngocnam.cad 6]

@NgocNam.Cad

Lisp này cách làm việc vẫn tương tự lisp cũ. Vì mình không tin tưởng việc làm thưa tự động (lại giống Nova thì bằng nhau) nên lisp vẫn yêu cầu xóa thủ công các đường dóng sao cho hợp lý nhất.

(chú ý: không được xóa đường dóng ngoài cùng bên trái mỗi trắc ngang vì lisp lấy đường này làm mốc tính toán)

Sau khi đã làm thưa đường dóng trên trắc ngang thì chạy lisp này. Tại dòng nhắc "Chọn trắc ngang cần sửa" chỉ cần chọn 1 đối tượng bất kỳ trên trắc ngang là được. Lisp này có thể chạy cả trong môi trường cad và nova mà không ảnh hưởng đến kết quả chạy nova. nếu gặp lỗi gì thì thông báo lại cho mình.

Lisp post bằng code của diễn đàn bị lỗi nên bạn download tại đây Njoy n' Have fun :undecided:

cám ơn bác rất nhiều. em dùng rồi .lisp dùng rất tốt bác à. thaks bác nhiều.chúc bác và gd mạnh khỏe

[ngocnam.cad 6]

bác vuvuzela đâu rùi nhỉ?

[ngocnam.cad 6]

chờ tin bác vuvu lâu quá bác à.

[VUVUZELA 100]

chờ tin bác vuvu lâu quá bác à.

 

HIHI

Gì thế bác

Tại bác không tin tui mà tui xuất hiện làm gì

Vả lại phương pháp của bác nhờ khác của tui

PP của bác là xử lý bản vẽ khi in sau khi thiết kế xong ==> cái này sau nộp file cho CĐT kiểm tra thì chết

Còn p2 của tui là xử lý bản vẽ ngay từ đầu (1 fát ăn ngay) ==> ra file *.ntd luôn ==> CĐT bó tay với PRO

:D

[ketxu 2984]

Mạn phép hỏi các bác có ai có lisp sắp xếp, cắt chân dim đối với các dim đã oblique rồi không nhỉ ??

[hugo75 4]

Bấn quá thì bạn dùng tạm nhé.Chỗ nét cắt thì bác ấy viết liền thành 1 nét rùi,giờ nghỉ trưa mình hơi ngại edit ^^

 

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P2 S)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(setq 
A (getreal "\nBe rong mc DAM:")
B (getreal "\nBe dai mc DAM:")
S (getreal "\nBe day san:")
BV (getreal "\nLop bv mc DAM:")
D (getint "\nS.luong thep ngang mc DAM:")
E (getint "\nS.luong thep doc mc DAM:")
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(setvar "clayer" "4")
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" "")
;".change" "L" "" "P" "C" 1 ""
(setvar "clayer" "1")
(command ".pline" (Polar P1 0 (/ A 2)) "W" 0 0 
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 2 S)) (cadr P11)))
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 2 S) (/ A 2)) (cadr P11)))
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) P11 ""
".pedit" "l" "j" "p" "l" "" ""
); end of command
(setvar "clayer" "3")
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
)

Cảm ơn bác,tiện bác giúp e các đường bao ngoài k phải là pline và đặt cho nét cắt là layer số 2 luôn nha.e mù lisp bác ah.Thanks

[ketxu 2984]

Cảm ơn bác,tiện bác giúp e các đường bao ngoài k phải là pline và đặt cho nét cắt là layer số 2 luôn nha.e mù lisp bác ah.Thanks

Theo mình bạn nên để Pline thì sẽ thấy thuận lợi hơn rất nhiều khi xử lý.

Lisp của bạn đây,mình đã rút ngắn khoảng cách vẽ sàn,không để nét cắt bị lộn nữa,hi vọng đúng ý bạn

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P11 P2 S)
(setq oldosmode (getvar "osmode"))
(setq oldlay (getvar "clayer"))
(setvar "osmode" 0)
(setq 
A (getreal "\nChieu rong mc DAM:") 
B (getreal "\nChieu cao mc DAM:") 
S (getreal "\nBe day san:")  
BV (getreal "\nLop bao ve mc DAM:") 
D (getint "\nS.luong thep ngang mc DAM:") 
E (getint "\nS.luong thep doc mc DAM:") 
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(setvar "clayer" "4")
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" "")
;".change" "L" "" "P" "C" 1 ""
(setvar "clayer" "1")
;Net bao duoi
(command ".pline" (Polar P1 0 (/ A 2))  
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 1.5 S)) (cadr P11))) 
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) (list (+ (car P1) (/ A 2) ) (+ (cadr P1) B )) "n" ""
".pedit" "L" "j" "p" "l" "" ""
);Xong net bao duoi
;Net cat
(setvar "clayer" "2")
(command ".Pline"
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S))) 
""
".copy" "L" "" P1 (list (+ (car P1) (* 3 S)  A ) (cadr P1)) ""
);xong net cat
(setvar "clayer" "1")
(command ".Line"
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 3 S)  A ) (cadr P11)))
""
); end of command
(setvar "clayer" "3")
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
(setvar "clayer" oldlay)
)

[NDBNGO 20]

Trên diễn đàn đã có nhiều phần lisp xuất text (giá trị cao độ) trên màn hình ra file (với định dạng thu tu,X,Y,Z) nhưng mình cần khi xuất ra file các tập hợp này được sắp sếp theo các lựa chon sau -4 lựa chọn người dùng-(giá trị X tăng, X giảm,Y tăng,Y giảm). Nhờ các ban có thể viết giúp mình lisp với các lựa chọn như vậy .

Trong các text này ,nếu giá trị text nào được lựa chọn bằng chuột (Chọn điểm text cần thêm ghi chú) thì sẽ thêm giá trị text theo người dùng yêu cầu khi xuất ra file (ví dụ mặc định là chữ T chẳng hạn)

Ví dụ : Sau khi chọn 1 tập hợp các text trên màn hình ,với chọn lựa Y tăng .Ta có 1 file *.txt như sau:

 

1 12.36 42.36 17.36

2 13.56 42.38 15.34

3 12.35 42.56 14.38 T

4 12.39 42.65 13.32

......

 

Trong file:

Cột 1 là số thứ tự

Cột 2 là giá trị x

Cột 3 giá trị y

Cột 4 giá trị Text trên màn hình

Cột 5 T là giá trị chuỗi thêm vào những text cần đánh dấu trên màn hình bằng bấm chuột (hoặc chọn)

 

Trước nay ,cá nhân vẫn xuất ra file txt,sau đó mở ra excel sử lý ,nhưng vì có nhiều tập hợp chọn ,hơn nữa các txt cần dánh dấu thì phải mở cả cad và excel tìm ra các điểm cần đánh dấu để gõ thêm ký tự vào tập hợp chọn. Làm như thế rất thủ công và mệt mỏi vì hay nhầm lẫn. Vậy nên cần có 1 lisp để xử lý các việc đã nêu ra ở trên

Xin cảm ơn.

[longtdh1 0]

Có ai biết cách truy cập basepoint của 1 block không giúp mình với.

Mình có một block. Ví dụ tên là "ABC" trong bản vẽ

Có thể dùng lập trình VBA để tìm basepoint của block này và xuất dữ liệu ra 1 biến blockbasepoint được không?

Dim blockbasepoint as double

...

[tiendaica 0]

không phải là mình viết, nhưnng mình có lips đó bàn dùng thử nha!

http://www.cadviet.com/upfiles/3/vmc_tbd.lsp

bạn cho mình hỏi thử đây sử dụng cho cad bao nhieu vậy sao khi load đánh lệnh td nó báo 1000 rồi minh enter no báo lỗi. bạn xem lai giùm minh nhé! cảm ơn bạn trước

[tiendaica 0]

không phải là mình viết, nhưnng mình có lips đó bàn dùng thử nha!

http://www.cadviet.com/upfiles/3/vmc_tbd.lsp

cám ơn bạn đã giúp đỡ mình nhưng lisp bạn bị lỗi hay sao đó ! mình đánh lệnh td nó thông báo ty le mình nhập 1000 nó báo lỗi! bạn xem lai giùm minh nhé

[NDBNGO 20]

cám ơn bạn đã giúp đỡ mình nhưng lisp bạn bị lỗi hay sao đó ! mình đánh lệnh td nó thông báo ty le mình nhập 1000 nó báo lỗi! bạn xem lai giùm minh nhé

Lisp này mình chạy thử trên cad 2004 bình thường không báo lỗi gì đâu.Bạn kiểm tra lai đi.

[ketxu 2984]

Mạn phép hỏi các bác có ai có lisp sắp xếp, cắt chân dim đối với các dim đã oblique rồi không nhỉ ??

Up ^^

[ketxu 2984]

cám ơn bạn đã giúp đỡ mình nhưng lisp bạn bị lỗi hay sao đó ! mình đánh lệnh td nó thông báo ty le mình nhập 1000 nó báo lỗi! bạn xem lai giùm minh nhé

Bạn nên tránh những câu như thế này,tốt nhất là hãy post thông báo lỗi lên,hoặc chụp ảnh lại.

[quan08 0]

Theo mình bạn nên để Pline thì sẽ thấy thuận lợi hơn rất nhiều khi xử lý.

Lisp của bạn đây,mình đã rút ngắn khoảng cách vẽ sàn,không để nét cắt bị lộn nữa,hi vọng đúng ý bạn

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P11 P2 S)
(setq oldosmode (getvar "osmode"))
(setq oldlay (getvar "clayer"))
(setvar "osmode" 0)
(setq 
A (getreal "\nChieu rong mc DAM:") 
B (getreal "\nChieu cao mc DAM:") 
S (getreal "\nBe day san:")  
BV (getreal "\nLop bao ve mc DAM:") 
D (getint "\nS.luong thep ngang mc DAM:") 
E (getint "\nS.luong thep doc mc DAM:") 
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(setvar "clayer" "4")
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" "")
;".change" "L" "" "P" "C" 1 ""
(setvar "clayer" "1")
;Net bao duoi
(command ".pline" (Polar P1 0 (/ A 2))  
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 1.5 S)) (cadr P11))) 
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) (list (+ (car P1) (/ A 2) ) (+ (cadr P1) B )) "n" ""
".pedit" "L" "j" "p" "l" "" ""
);Xong net bao duoi
;Net cat
(setvar "clayer" "2")
(command ".Pline"
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S))) 
""
".copy" "L" "" P1 (list (+ (car P1) (* 3 S)  A ) (cadr P1)) ""
);xong net cat
(setvar "clayer" "1")
(command ".Line"
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 3 S)  A ) (cadr P11)))
""
); end of command
(setvar "clayer" "3")
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
(setvar "clayer" oldlay)
)

Lisp này vẽ tỉ lệ 1:1 bác có thể sửa lại mặc định của lisp này là vẽ 1:20 (tức nếu mình nhập chiều rộng dầm là 300 thì nó sẽ vẽ là 300*5=1500) giùm e được không?Chân thành cảm ơn bác trước.

[cuti0022 0]

Chào mọi người!! ai có thể viết giúp e cái lisp vẽ các loại của 1,2,4 cánh và cửa sổ không. Em đã tìm hết rồi nhưng đều thấy chỉ là chương trình phụ trợ không dành cho win 7. và có người viết lisp rồi nhưng không dùng được. e xin cảm ơn trước ah. ( e cũng đã tìm luôn trên google nhưng khong thấy ) ai chỉ giúp e với!

[phamthanhbinh 3146]

Lisp này vẽ tỉ lệ 1:1 bác có thể sửa lại mặc định của lisp này là vẽ 1:20 (tức nếu mình nhập chiều rộng dầm là 300 thì nó sẽ vẽ là 300*5=1500) giùm e được không?Chân thành cảm ơn bác trước.

Hề hề hề,

Mình ngu quá, không hiểu nổi ý của bạn, bạn có thể giải thích giùm vì sao tỷ lệ là 1:20 thì kích thước 300 lại thành 1500 được không???

Vì không hiểu rõ nên cũng không thể giúp bạn được. Mong bạn tha lỗi...

[ketxu 2984]

Bạn ấy nói nhầm ấy mà bác.Vẽ tỉ lệ 1:20 thì nhập 300 nó sẽ ra 15 unit thôi ^^

Nếu đã mặc định 1:20 rồi thì chẳng cần phải hỏi tỉ lệ chi nữa cho dài dòng, ta cứ chia số nhập cho 20 luôn hè ^^

 

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P11 P2 S)
(setq oldosmode (getvar "osmode"))
(setq oldlay (getvar "clayer"))
(setvar "osmode" 0)
(setq 
A (/ (getreal "\nChieu rong mc DAM:") 20)
B (/ (getreal "\nChieu cao mc DAM:") 20)
S (/ (getreal "\nBe day san:")  20)
BV (/ (getreal "\nLop bao ve mc DAM:") 20)
D (/ (getint "\nS.luong thep ngang mc DAM:")  20)
E (/ (getint "\nS.luong thep doc mc DAM:") 20)
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(setvar "clayer" "4")
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" "")
;".change" "L" "" "P" "C" 1 ""
(setvar "clayer" "1")
;Net bao duoi
(command ".pline" (Polar P1 0 (/ A 2)) 
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 1.5 S)) (cadr P11))) 
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) (list (+ (car P1) (/ A 2) ) (+ (cadr P1) B )) "n" ""
".pedit" "L" "j" "p" "l" "" ""
);Xong net bao duoi
;Net cat
(setvar "clayer" "2")
(command ".Pline"
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S))) 
""
".copy" "L" "" P1 (list (+ (car P1) (* 3 S) A ) (cadr P1)) ""
);xong net cat
(setvar "clayer" "1")
(command ".Line"
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 3 S) A ) (cadr P11)))
""
); end of command
(setvar "clayer" "3")
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
(setvar "clayer" oldlay)
)

[quan08 0]

Bạn ấy nói nhầm ấy mà bác.Vẽ tỉ lệ 1:20 thì nhập 300 nó sẽ ra 15 unit thôi ^^

Nếu đã mặc định 1:20 rồi thì chẳng cần phải hỏi tỉ lệ chi nữa cho dài dòng, ta cứ chia số nhập cho 20 luôn hè ^^

 

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P11 P2 S)
(setq oldosmode (getvar "osmode"))
(setq oldlay (getvar "clayer"))
(setvar "osmode" 0)
(setq 
A (/ (getreal "\nChieu rong mc DAM:") 20)
B (/ (getreal "\nChieu cao mc DAM:") 20)
S (/ (getreal "\nBe day san:")  20)
BV (/ (getreal "\nLop bao ve mc DAM:") 20)
D (/ (getint "\nS.luong thep ngang mc DAM:")  20)
E (/ (getint "\nS.luong thep doc mc DAM:") 20)
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(setvar "clayer" "4")
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" "")
;".change" "L" "" "P" "C" 1 ""
(setvar "clayer" "1")
;Net bao duoi
(command ".pline" (Polar P1 0 (/ A 2)) 
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 1.5 S)) (cadr P11))) 
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) (list (+ (car P1) (/ A 2) ) (+ (cadr P1) B )) "n" ""
".pedit" "L" "j" "p" "l" "" ""
);Xong net bao duoi
;Net cat
(setvar "clayer" "2")
(command ".Pline"
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S))) 
""
".copy" "L" "" P1 (list (+ (car P1) (* 3 S) A ) (cadr P1)) ""
);xong net cat
(setvar "clayer" "1")
(command ".Line"
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 3 S) A ) (cadr P11)))
""
); end of command
(setvar "clayer" "3")
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
(setvar "clayer" oldlay)
)

Cảm ơn bác e đã hiểu và sửa được rồi.

[790312 5]

E thấy trên diễn đàn có 1 lisp vẽ thép hình I,khi vẽ lần đầu thì rất tốt nhưng khi vẽ lần 2 thì bị lỗi.Mong các bác xem và sửa lại giùm.Thanks.

(defun c:Is ()
(setq h (getreal "\n Nhap chieu cao mat cat : ")
b (getreal "\n Nhap chieu rong mat cat : ")
d (getreal "\n Nhap chieu day ban canh : ")
db (getreal "\n Nhap chieu day ban bung : ")
p0 (getpoint "\n Nhap diem khoi tao"))
(command "rectang" p0 (list (+ b (car p0)) (- (cadr p0) d)))
(setq a0 (entlast))
(command "rectang" (list (car p0) (- (cadr p0) h)) (list (+ (car p0) b ) (- (cadr p0) (- h d))))
(setq a1 (entlast))
(setq p1 (list (+ (car p0) (/ (- b db) 2)) (- (cadr p0) d))
p2 (polar p1 0 db)
p3 (polar p1 (- (/ pi 2)) (- h d d))
p4 (polar p3 0 db))
(command "pline" p1 p3 "")
(setq a2 (entlast))
(command "pline" p2 p4 "")
(setq a3 (entlast))
(command "break" a0 p1 p2)
(command "break" a1 p3 p4)
(command "bhatch" "s" a0 a1 a2 a3 "" "p" "ansi31" 50 0 "" "")
(princ)
)

[ketxu 2984]

1.Để người khác bắt bệnh, bạn nên chụp lại hiện trường để người ta khám chứ :D Bạn thao tác lại,đến lúc gặp lỗi thì ấn F2 để bật màn hình command lên, rồi chụp lại thông báo post lên diễn đàn

2.Đành xem qua code,mình dùng vẫn bình thường, chỉ khấp khiểng chỗ lệnh bhatch thôi,n vẫn k sao cả :D Bạn thử lại cái này xem sao.Cái này là chữa kiểu mù mờ này ^^

(defun c:Is ()
(setq h (getreal "\n Nhap chieu cao mat cat : ")
b (getreal "\n Nhap chieu rong mat cat : ")
d (getreal "\n Nhap chieu day ban canh : ")
db (getreal "\n Nhap chieu day ban bung : ")
p0 (getpoint "\n Nhap diem khoi tao"))
(command "rectang" p0 (list (+ b (car p0)) (- (cadr p0) d)))
(setq a0 (entlast))
(command "rectang" (list (car p0) (- (cadr p0) h)) (list (+ (car p0) b ) (- (cadr p0) (- h d))))
(setq a1 (entlast))
(setq p1 (list (+ (car p0) (/ (- b db) 2)) (- (cadr p0) d))
p2 (polar p1 0 db)
p3 (polar p1 (- (/ pi 2)) (- h d d))
p4 (polar p3 0 db))
(command "pline" p1 p3 "")
(setq a2 (entlast))
(command "pline" p2 p4 "")
(setq a3 (entlast))
(command "break" a0 p1 p2)
(command "break" a1 p3 p4)
(command "bhatch" "s" a0 a1 a2 a3 "" "p" "ansi31" 50 0 "")
(princ)
)

[790312 5]

1.Để người khác bắt bệnh, bạn nên chụp lại hiện trường để người ta khám chứ :D Bạn thao tác lại,đến lúc gặp lỗi thì ấn F2 để bật màn hình command lên, rồi chụp lại thông báo post lên diễn đàn

2.Đành xem qua code,mình dùng vẫn bình thường, chỉ khấp khiểng chỗ lệnh bhatch thôi,n vẫn k sao cả :D Bạn thử lại cái này xem sao.Cái này là chữa kiểu mù mờ này ^^

(defun c:Is ()
(setq h (getreal "\n Nhap chieu cao mat cat : ")
b (getreal "\n Nhap chieu rong mat cat : ")
d (getreal "\n Nhap chieu day ban canh : ")
db (getreal "\n Nhap chieu day ban bung : ")
p0 (getpoint "\n Nhap diem khoi tao"))
(command "rectang" p0 (list (+ b (car p0)) (- (cadr p0) d)))
(setq a0 (entlast))
(command "rectang" (list (car p0) (- (cadr p0) h)) (list (+ (car p0) b ) (- (cadr p0) (- h d))))
(setq a1 (entlast))
(setq p1 (list (+ (car p0) (/ (- b db) 2)) (- (cadr p0) d))
p2 (polar p1 0 db)
p3 (polar p1 (- (/ pi 2)) (- h d d))
p4 (polar p3 0 db))
(command "pline" p1 p3 "")
(setq a2 (entlast))
(command "pline" p2 p4 "")
(setq a3 (entlast))
(command "break" a0 p1 p2)
(command "break" a1 p3 p4)
(command "bhatch" "s" a0 a1 a2 a3 "" "p" "ansi31" 50 0 "")
(princ)
)

Khi thực hiện xong nhấn F2 thì nó không báo lỗi,nhưng khi vẽ bản bụng nó chỉ vẽ 1 đường thẳng.E gửi file đính kèm mong bác xem giúp e

http://www.cadviet.com/upfiles/3/drawing1_7.rar

[Tue_NV 3912]

Khi thực hiện xong nhấn F2 thì nó không báo lỗi,nhưng khi vẽ bản bụng nó chỉ vẽ 1 đường thẳng.E gửi file đính kèm mong bác xem giúp e

http://www.cadviet.com/upfiles/3/drawing1_7.rar

Bạn tắt chế độ bắt điểm OSNAP đi rồi chạy Lisp là được

Hoặc bạn viết 1 đoạn code bổ sung vào Lisp

(defun c:is()

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

.....

.....

(setvar "osmode" oldos)

(princ)

)

:D