Jump to content
InfoFile
Tác giả: KangKung
Bài viết gốc: 230616
Tên lệnh: kk
Thay đổi máy in hàng loạt cho tất cả layout?

Lisp thay đổi máy in cho tất cả các Layout đây:

Chú ý:

1. Khi chọn máy in thì chọn số tương ứng với máy in đó. VD: Chọn 1 hoặc 2 , 3, 4 ...

2. Nhập khổ giấy phải đúng tên của khổ giấy trong máy in đó. VD: cùng là khổ giấy A0 nhưng có máy là A0 nhưng có máy lại là ISO A0.

;========LISP THAY DOI PLOTTER CHO TAT CA LAYOUT===========
;================KANGKUNG...
>>

Lisp thay đổi máy in cho tất cả các Layout đây:

Chú ý:

1. Khi chọn máy in thì chọn số tương ứng với máy in đó. VD: Chọn 1 hoặc 2 , 3, 4 ...

2. Nhập khổ giấy phải đúng tên của khổ giấy trong máy in đó. VD: cùng là khổ giấy A0 nhưng có máy là A0 nhưng có máy lại là ISO A0.

;========LISP THAY DOI PLOTTER CHO TAT CA LAYOUT===========
;================KANGKUNG 03/04/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (Plotter_list)
  (setq printer(getint (strcat "\n Chon may in " printer2 ":")))
  (setq printer(vl-string-trim ".pc3" (nth (- printer 1) (vl-directory-files (strcat (getvar "roamablerootprefix") "\Plotters\\") "*.pc3" 1))))
  (setq size(getstring T "\n Kho giay in <Nhap A0, A1, A2 ... hoac ISO A0, ISO A1, ISO A2 ...: "))
  (foreach layout (layoutlist)
    (command "LAYOUT" "S" layout)
    (Setq P1(Getvar "EXTMIN") P2(Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer size "M" "L" "N" "W" P1 P2 "1" "C" "Y" "" "Y" "N" "N" "N" "N" "Y" "N"))
  (command "MODEL")
  (command "UNDO" "END")
  (alert "Well Done")
  (princ)
  )
(defun Plotter_list()
  (setq lst_printer(vl-directory-files (strcat (getvar "roamablerootprefix") "\Plotters\\") "*.pc3" 1))
  (setq lst_printer2 (list))
  (setq printer2 "")
  (setq i 0)
  (foreach printer lst_printer
    (setq i(1+ i))
    (setq printer2(strcat printer2 (strcat (substr (rtos i 1 0)  1 1) "-" "\""(vl-string-trim ".pc3" printer)"\"" " ")))
    (setq lst_printer2(append lst_printer2 (list (strcat (substr (rtos i 1 0)  1 1) "-" (vl-string-trim ".pc3" printer))))))
  )
(princ "\n                Written By KangKung - 03/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

<<

Filename: 230616_kk.lsp
Tác giả: Tue_NV
Bài viết gốc: 77939
Tên lệnh: tdt
Viết lisp theo yêu cầu [phần 2]

Đơn giản nếu là hình vuông,hình chữ nhật thì là điểm giao của 2 đường chéo thôi.còn hình tròn thì tâm của đường tròn.Cảm ơn bác rất nhiều.

Bạn thử cái này xem :
Tue_NV ghi toạ độ trọng tâm tại trọng tâm luôn


Filename: 77939_tdt.lsp
Tác giả: Tue_NV
Bài viết gốc: 78482
Tên lệnh: ltruc
Viết lisp theo yêu cầu [phần 2]

Phù. Cuối cùng cũng hoàn thành Lisp bố trí cột vào lưới
'Trần Diệu Nhân' thử nhé
Chức năng download Lisp file của diễn đàn đôi lúc bị lỗi. Nếu sử dụng chức năng này không được bạn nhấn nút Reply bài viết của Tue_NV (không sót nhé) về chạy là được

:tongue2:

Filename: 78482_ltruc.lsp
Tác giả: thiep
Bài viết gốc: 80037
Tên lệnh: nsmc
Viết lisp theo yêu cầu [phần 2]

Chào dkkx3a, lâu lâu Thiep cũng tranh thủ lúc rảnh rỗi viết 1 cái lisp giúp anh em cho vui.
Lisp này không kén đường mặt cắt của bạn là gì, có thể là SPLINE, LWPOLYLINE, POLYLINE, ARC, thậm chí là các đường cong kín ... gọi chung CURVẸ. Lisp yêu cầu user pick CURVẸ đường mặt cắt thứ I, pick CURVẸ đường mặt cắt thứ II, đưa vào tỷ lệ vị trí mặt cắt cần nội suy: giả sử khoảng cách...
>>

Chào dkkx3a, lâu lâu Thiep cũng tranh thủ lúc rảnh rỗi viết 1 cái lisp giúp anh em cho vui.
Lisp này không kén đường mặt cắt của bạn là gì, có thể là SPLINE, LWPOLYLINE, POLYLINE, ARC, thậm chí là các đường cong kín ... gọi chung CURVẸ. Lisp yêu cầu user pick CURVẸ đường mặt cắt thứ I, pick CURVẸ đường mặt cắt thứ II, đưa vào tỷ lệ vị trí mặt cắt cần nội suy: giả sử khoảng cách giữa 2 mặt cắt I và II là 200, khoảng cách giữa mặt cắt I và mặt cắt nội suy là 25, thì tỷ lệ vị trí mặt cắt cần nội suy là 25/200 = 12.5 Cái này bạn phải chia tỷ lệ trước bên ngoài.
Lisp này cũng có thể dùng để nội suy 1 đường contour phụ từ 2 đường contour chính, tuy nhiên 2 đường contour chính phải có 2 node đầu (STARTPOINT) phải gần nhau nhất.

<<

Filename: 80037_nsmc.lsp
Tác giả: dkkx3a
Bài viết gốc: 80630
Tên lệnh: 2
Viết lisp theo yêu cầu [phần 2]



Xin cảm ơn Bác Tuệ đã góp ý. Mình viết lại LISP cho bạn thế này:


Có gì chưa đúng bạn cứ Post lên.

Filename: 80630_2.lsp
Tác giả: KangKung
Bài viết gốc: 230637
Tên lệnh: kk
[ Yêu cầu ] Xuất điểm theo Block thuộc tính qui định bởi tên

Lisp mới đây bạn ơi. Chức năng như cũ + đưa thêm điểm chi tiết lên bản vẽ. Nhớ copy cái File này vào Support nhé: 

http://www.cadviet.com/upfiles/3/71162_point_1.dwg

;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq...
>>

Lisp mới đây bạn ơi. Chức năng như cũ + đưa thêm điểm chi tiết lên bản vẽ. Nhớ copy cái File này vào Support nhé: 

http://www.cadviet.com/upfiles/3/71162_point_1.dwg

;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file file_in(open file "R"))
  (while(setq txt(read-line file_in))
    (if (/= txt nil)
      (progn
	(setq lst (read (strcat "(" txt ")"  )))
	(if (= (read txt) (atof (vl-princ-to-string(read txt))))
	  (command "INSERT" "Point" (list (nth 2 lst) (nth 1 lst) (nth 3 lst)) "1" "1" "0" (rtos (nth 0 lst) 2 0) (rtos (nth 3 lst) 2 2) (vl-princ-to-string(nth 4 lst)))
	  (progn
	    (setq Code(substr txt 1 (- (vl-string-search (rtos (fix (nth (- (length lst) 3) lst)) 2 0) txt) 1)))
	    (cond ((= (strcase(substr Code 1 2)) "TM") (in "TM"))
		  ((= (strcase(substr Code 1 3)) "GPS") (in "GPS"))
		  ((= (strcase(substr Code 1 3)) "DCI") (in "DCI"))
		  ((= (strcase(substr Code 1 4)) "DCII") (in "DCII"))
		  )
	    )
	  )
	)
      )
    )
  (close file_in)
  (setvar "OSMODE" os)
  (command "ZOOM" "E")
  (command "UNDO" "END")
  (Alert "Well Done")
  )
(defun in(ten)
  (command "INSERT" ten (list (nth (- (length lst) 2) lst) (nth (- (length lst) 3) lst) (nth (- (length lst) 1) lst)) "1" "1" "0" Code (rtos (nth (- (length lst) 1) lst) 2 3)))
(princ "\n                Written By KangKung - 03/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

 

 


<<

Filename: 230637_kk.lsp
Tác giả: namnhim
Bài viết gốc: 189509
Tên lệnh: %3Cspan+clas
Cho mình hỏi cách cài đặt khung, Layer, dim, text sẵn trong cad khi khởi động là có luôn
tôi có 1 đoạn lisp này có thể bạn dùng được:

===================================
TAO CAC LOAI KHUNG MAU BAN VE CO SAN:
===================================
(defun C:KHUNG (/ )
(command "cmdecho" 0)
(command "osnap" "none")
(setq DIEMCHEN (getpoint "CHON GOC TRAI-DUOI BAN VE"))
(chenkhungCG DIEMCHEN) ;VE CAC KHUNG TY LE CHUAN DE DINH HUONG
(setq MSTL (getreal "\nCHON...
>>
tôi có 1 đoạn lisp này có thể bạn dùng được:

===================================
TAO CAC LOAI KHUNG MAU BAN VE CO SAN:
===================================
(defun C:KHUNG (/ )
(command "cmdecho" 0)
(command "osnap" "none")
(setq DIEMCHEN (getpoint "CHON GOC TRAI-DUOI BAN VE"))
(chenkhungCG DIEMCHEN) ;VE CAC KHUNG TY LE CHUAN DE DINH HUONG
(setq MSTL (getreal "\nCHON TY LE BAN VE (BAM SO TUONG UNG T/LE:100;200;250;500;1000;2000): "))
;XOA CAC KHUNG DINH HUONG
(repeat 12 (command "_erase" (ssget "L") ""))
;CHEN MAU HO SO VAO
(setq DUONGDAN "c:\\program files\\AutoCAD 2004\\Khung\\")
(setq LOAIHS "Khung")
(setq TENFILE (strcat LOAIHS (rtos MSTL 2 0) ".dwg"))
(ChenBlock DUONGDAN TENFILE DIEMCHEN (/ MSTL 1000))
(prompt "\nDA TAO XONG KHUNG BAN VE!")(command "osnap" "End,Mid,Int,Perp")(Princ)
);END DEFUN KHUNG
===================================
;SCALE BAN VE LAM TANG CO CHU KICH THUOC THEO TY LE
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob))
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")))
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)))
;==========
(defun C:SCC( / ss ssd p k opt)(prompt "\nGo lenh: SCC de phong to hoac thu nho ban ve va kich thuoc ")
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nTAM DIEM KHI SCALE:")
k (getreal "\nSCALE LEN MAY LAN:")
;opt (strcase (getstring "\nDim scale overall? :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(prompt "\nDA PHONG TO BAN VE VA KICH THUOC!")(Princ)
)

VÀ TẠO CÁC FILE MẪU TỈ LỆ: 1/100; 1/200; 1/250; 1/500; 1/1000; 1/2000.
LƯU Ý: TẠO 1 FILE MẪU TỈ LỆ 1/1000, SAU ĐÓ COPY THÀNH CÁC FILE NHƯNG VẪN DỮ NGUYÊN TỈ LỆ 1/1000 VÀ CHỈ SỬA CHỮ TỈ LỆ Ở PHẦN NHƯ HÌNH MINH HỌA KÈM THEO" TỶ LỆ: 1/1*** (Đơn vị cm)" BÊN TRONG BẢN VẼ VÀ XỬ DỤNG LỆNH SCC KÈM THEO ĐỂ SCALE DIM CHO ĐÚNG TỈ LỆ NGOÀI RA KHÔNG ĐƯỢC SCALE KHUNG RỒI LƯU FILE VẬY LÀ OK.
BẢN VẼ SẼ TỰ SCALE KHUNG KHI MÌNH GÕ LỆNH: KHUNG -> NHẬP SỐ TƯƠNG ỨNG VỚI TỈ LỆ 100 HOẶC 200 ...., VÀ NÓ SẼ HIỆN LÊN KHUNG NHƯ MÌNH ĐÃ MẶC ĐỊNH!
NHỚ COPY FILE KHUNG CỦA MÌNH THEO ĐÚNG ĐƯỜNG DẪN VÀO Ổ "c:\\program files\\AutoCAD 2004\\Khung\\"SAU ĐÓ SỬA VÀ LƯU FILE VÀO ĐÓ.
BẢN VẼ KÈM THEO ĐÃ CÓ KÍCH THƯỚC CHUẨN THEO TỪNG TỈ LỆ VÀ BẢN VẼ VẪN GIỮ NGUYÊN TỈ LỆ 1/1000:
http://www.cadviet.com/upfiles/3/62465_khung.rar
<<

Filename: 189509_%3Cspan+clas.lsp
Tác giả: quansla
Bài viết gốc: 215720
Tên lệnh: veline
làm sao biết người dùng kết thúc lệnh dimcontinue

Bạn dùng điều kiện vòng lặp while cũng được, ví dụ như (while (setq p (getpoint p1 "\Toa do diem 2"))....(command "Dimcontinue" p1 p2)(setq p1 p2))..
Ví dụ như

(defun c:veline (/ p1 p2)
(setq p1 nil
p2 nil
)
(setq p1 (getpoint "\nNhap toa do diem dau"))
(while (setq p2 (getpoint p1 "\nNhap diem tiep theo"))
(entmake
(list
(cons 0...
>>

Bạn dùng điều kiện vòng lặp while cũng được, ví dụ như (while (setq p (getpoint p1 "\Toa do diem 2"))....(command "Dimcontinue" p1 p2)(setq p1 p2))..
Ví dụ như

(defun c:veline (/ p1 p2)
(setq p1 nil
p2 nil
)
(setq p1 (getpoint "\nNhap toa do diem dau"))
(while (setq p2 (getpoint p1 "\nNhap diem tiep theo"))
(entmake
(list
(cons 0 "line")
(cons 8 "tuong")
(cons 10 p1)
(cons 11 p2)
)
)
(setq p1 p2)
)
(princ)
)

<<

Filename: 215720_veline.lsp
Tác giả: namnhim
Bài viết gốc: 230698
Tên lệnh: td5
[Yêu cầu] nhờ sửa thêm phần gọi Block text và cho nó song song đoạn thẳng

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext mẫu có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

 

(DEFUN C:TD5(/ cnt enam ent pnt...
>>

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext mẫu có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

 

(DEFUN C:TD5(/ cnt enam ent pnt s1 tot v1 val)(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   ("CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (SETQ B (GETPOINT "CHON DIEM : diem dau  -  "))(PRINC)
   (SETQ C (GETPOINT "CHON DIEM : diem cuoi"))
   (command "-style" "TEXT" "Times New Roman" "1.1" "1" "0" "n" "n" )
   (command "-layer" "m" "Text"" "" "" "")
   (command "text" "j" "bl" B C (strcase(getstring T "NHAP TEN DUONG:   ")))
  (command "textstyle" tl)(princ))

 


<<

Filename: 230698_td5.lsp
Tác giả: tientracdia
Bài viết gốc: 229659
Tên lệnh: xtsn
Could you send me an application form? buy cialis europe Weekly claims fell another 9,000 to 323,000, consistent with an improving climate that likely will do nothing to deter the Federal Reserve from its i

Filename: 229659_xtsn.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 4308
Tên lệnh: cvt cvtrim cvtl
Viết Lisp theo yêu cầu


Có 3 lệnh dưới đây đáp ứng được 3 yêu cầu của bạn:
1. lệnh CVT: vẽ tường cân từ một line hoặc pline. Đầu vào: đối tượng (poly)line, chiều dày tường.
2. lệnh CVTL: vẽ tường lệch từ một line hoặc pline và bề dày. Đầu vào: đối tượng (poly)line, phía offset, khoảng cách offset, chiều dày tường.
3. lệnh CVTRIM: cắt bỏ đoạn line giao nhau giữa 2 tường. Đầu vào:...
>>


Có 3 lệnh dưới đây đáp ứng được 3 yêu cầu của bạn:
1. lệnh CVT: vẽ tường cân từ một line hoặc pline. Đầu vào: đối tượng (poly)line, chiều dày tường.
2. lệnh CVTL: vẽ tường lệch từ một line hoặc pline và bề dày. Đầu vào: đối tượng (poly)line, phía offset, khoảng cách offset, chiều dày tường.
3. lệnh CVTRIM: cắt bỏ đoạn line giao nhau giữa 2 tường. Đầu vào: 4 đường, chia làm 2 cặp. Mỗi cặp thể hiện một tường.
Như vậy, lệnh CVTL tuy có khác so với yêu cầu thứ 2 của bạn, nhưng nó điển hình hơn. Khi bạn muốn làm như yêu cầu thứ 2 của bạn, bạn kết hợp lệnh CVTL và lệnh CVTRIM là được.


<<

Filename: 4308_cvt_cvtrim_cvtl.lsp
Tác giả: KangKung
Bài viết gốc: 230817
Tên lệnh: kk
[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

Lisp mới đây. Tuy nhiên cách bạn đang làm việc hơi thiếu khoa học, làm lấy được chứ chưa có phương pháp tối ưu. Nếu quản lý đối tượng bằng block thuộc tính thì cách nhập số liệu đơn giản hơn nhiều. Lần đầu bạn muốn nhập số liệu với 4 cột, lần này là 6 cột, lần thứ n thì bao nhiêu? Tất cả điều này được giải quyết dễ dàng và đơn giản bằng cách sử dụng block thuộc...

>>

Lisp mới đây. Tuy nhiên cách bạn đang làm việc hơi thiếu khoa học, làm lấy được chứ chưa có phương pháp tối ưu. Nếu quản lý đối tượng bằng block thuộc tính thì cách nhập số liệu đơn giản hơn nhiều. Lần đầu bạn muốn nhập số liệu với 4 cột, lần này là 6 cột, lần thứ n thì bao nhiêu? Tất cả điều này được giải quyết dễ dàng và đơn giản bằng cách sử dụng block thuộc tính. Muốn bao nhiêu số liệu thì chỉ cần thay đổi block thuộc tính là được thôi chứ không mất thời gian ngồi đo đo tính tính vị trí các Text rồi nhét vào trong code như mình đã làm. Mặt khác để Text như trên bản vẽ của bạn thì lại chưa có Lisp xuất ngược ra txt. Và nói trước là mình sẽ không chạy theo yêu cầu của bạn một lần nữa đâu nhé. Nếu bạn dùng block thuộc tính thì xuất ngược xuôi gì đều được hết.

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
;================ UPDATED 05/04/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))) os(getvar "OSMODE"))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file index 0 TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT))))
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))))
    (setq index (1+ index)))
  (setq file_in(open file "R") lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0627) (- (cadr pt1) 0.9735)) pt3(list (+ (car pt1) 1.2873) (- (cadr pt1) 0.9735))
		pt4(list (- (car pt1) 1.0627) (- (cadr pt1) 2.0669)) pt5(list (+ (car pt1) 1.2873) (- (cadr pt1) 2.0669))
		pt6(list (car pt1) (- (cadr pt1) 3.1385))
		)
	  (command "ZOOM" "W" (list (- (car pt1) 3) (+ (cadr pt1) 2)) (list (+ (car pt1) 3) (- (cadr pt1) 5)))
	  (command "ERASE" "W" (list (- (car pt1) 3) (+ (cadr pt1) 1)) (list (+ (car pt1) 3) (- (cadr pt1) 4)) "")
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.3281) (- (cadr pt1) 0.4652)))	(cons 11 (list (+ (car pt1) 2.3281) (- (cadr pt1) 0.4652)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.4999) (- (cadr pt1) 1.3975)))	(cons 11 (list (+ (car pt1) 2.4999) (- (cadr pt1) 1.3975)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.2015) (- (cadr pt1) 2.5608)))	(cons 11 (list (+ (car pt1) 2.2015) (- (cadr pt1) 2.5608)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (car pt1) (- (cadr pt1) 0.4652)))	(cons 11 (list (car pt1) (- (cadr pt1) 2.5608)))
		  ))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer1") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(nth 0 lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer2") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (nth 1 lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer3") (cons 62 3) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (nth 2 lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer4") (cons 62 130) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (nth 3 lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer5") (cons 62 3) (cons 10 pt5) (cons 40 0.5) (cons 1 (rtos (nth 4 lst) 2 2)) (cons 72 1) (cons 11 pt5) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer6") (cons 62 31) (cons 10 pt6) (cons 40 0.5) (cons 1 (rtos (nth 5 lst) 2 2)) (cons 72 1) (cons 11 pt6) (cons 73 2)))
	  )
	)
      )
    )
  (close file_in)
  (command "UNDO" "END")
  (alert "Well Done")
  )
(princ "\n                Written By KangKung - 05/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

<<

Filename: 230817_kk.lsp
Tác giả: KangKung
Bài viết gốc: 230828
Tên lệnh: kk
[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

Lisp mới đây. Trước khi chạy bạn Copy cái này vào Support:

http://www.cadviet.com/upfiles/3/71162_block_tientracdia.dwg

(Chú ý: sau khi download về thì đổi tên File thành BLOCK_TIENTRACDIA.dwg)

Sau khi chạy Lisp thì số liệu sẽ là Block thuộc tính. Dùng Lisp ở #11 để xuất ngược lại sang TXT. Nếu muốn số liệu trên bản...

>>

Lisp mới đây. Trước khi chạy bạn Copy cái này vào Support:

http://www.cadviet.com/upfiles/3/71162_block_tientracdia.dwg

(Chú ý: sau khi download về thì đổi tên File thành BLOCK_TIENTRACDIA.dwg)

Sau khi chạy Lisp thì số liệu sẽ là Block thuộc tính. Dùng Lisp ở #11 để xuất ngược lại sang TXT. Nếu muốn số liệu trên bản vẽ là các Text bình thường thì dùng lệnh BURST để phá vỡ các Block thuộc tính.

;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU==========
;================KANGKUNG 25/03/2013=======================
;=================UPDATED 05/04/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))))
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path)
    (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2))
  (setq Path file)
  (setq index 0)
  (setq TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT)))
	  )
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))
	)
      )
    (setq index (1+ index))
    )
  (setq file_in(open file "R"))
  (setq lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt(cadr dt))
	  (command "ZOOM" "W" (list (- (car pt) 3) (+ (cadr pt) 2)) (list (+ (car pt) 3) (- (cadr pt) 5)))
	  (command "ERASE" "W" (list (- (car pt) 3) (+ (cadr pt) 2)) (list (+ (car pt) 3) (- (cadr pt) 5)) "")
	  (command "INSERT"  "BLOCK_TIENTRACDIA"  pt  "1" "1" "0"
		   (vl-princ-to-string(car lst))
		   (rtos (nth 1 lst) 2 2)
		   (rtos (nth 2 lst) 2 2)
		   (rtos (nth 3 lst) 2 2)
		   (rtos (nth 4 lst) 2 2)
		   (rtos (nth 5 lst) 2 2)
		 )
	  )
	)
      )
    )
  (close file_in)
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (alert "Da xong \n\n Muon pha Block thi dung lenh BURST")
  (princ "\n BURST de pha Block")
  (princ)
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

<<

Filename: 230828_kk.lsp
Tác giả: ThuyLinh313
Bài viết gốc: 230746
Tên lệnh: cf
Cải tạo các lệnh cơ bản của cad

Nếu bạn lười đến mức ngại với con chuột lên góc màn hình để đóng bản vẽ thì lisp dưới đây sẽ giúp bạn thay thế công việc "nặng nhọc" đó bằng 1 lệnh tắt.

(defun C:CF () ; Close file
(if (= (rem (getvar "dbmod") 2) 0) 
(command "close" "y") 
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "close ")))

Mình nói thế cho vui thôi, lisp này mục đích để cải...

>>

Nếu bạn lười đến mức ngại với con chuột lên góc màn hình để đóng bản vẽ thì lisp dưới đây sẽ giúp bạn thay thế công việc "nặng nhọc" đó bằng 1 lệnh tắt.

(defun C:CF () ; Close file
(if (= (rem (getvar "dbmod") 2) 0) 
(command "close" "y") 
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "close ")))

Mình nói thế cho vui thôi, lisp này mục đích để cải tạo lại 1 chút thao tác đóng bản vẽ.

Với cách close bản vẽ thông thường thì nếu có bất kì thay đổi nào của bản vẽ, kể cả bạn mở bản vẽ ra chỉ để zoom và pan để xem thì khi đóng lại, Cad hâm vẫn cứ hỏi bạn 1 câu vô nghĩa: có lưu trước khi đóng hay không? Dùng Lisp trên bạn sẽ né được câu hỏi này. Nó đặc biệt hữu dụng với những ai thường xuyên làm công việc duyệt bản vẽ của đồng nghiệp.

 

Chú ý: với những bạn có add sẵn các lisp khởi động cùng cad mà bản thân các lisp này thay đổi 1 hay nhiều biến hệ thống nào đó của cad thì để né câu hỏi trên bạn cần thêm 2 thao tác sau nữa:

- Đặt hàm (acad-push-dbmod) vào Đầu lisp đầu tiên trong danh mục Startup Suite

- Đăt hàm (acad-pop-dbmod) vào Cuối lisp cuối cùng trong danh mục Startup Suite

Chúc các bạn duyệt bản vẽ vui vẻ ^^


<<

Filename: 230746_cf.lsp
Tác giả: Mọt Sách
Bài viết gốc: 225256
Tên lệnh: bh
Gọi lisp bằng VBA
Em có code tạo menu bằng VBA như sau:

Sub TaoMenu()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
On Error Resume Next
Set newMenu = currMenuGroup.Menus.Add("My Program")
If Err <> 0 Then
Set newMenu = currMenuGroup.Menus("My Program")
Dim menuEnt As AcadPopupMenuItem
For Each menuEnt In...
>>
Em có code tạo menu bằng VBA như sau:

Sub TaoMenu()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
On Error Resume Next
Set newMenu = currMenuGroup.Menus.Add("My Program")
If Err <> 0 Then
Set newMenu = currMenuGroup.Menus("My Program")
Dim menuEnt As AcadPopupMenuItem
For Each menuEnt In newMenu
menuEnt.Delete
Next
End If
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
openMacro = "-vbarun SubMenu1 "
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Sub Menu 1", openMacro)
openMacro = "-vbarun SubMenu2 "
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Sub Menu 2", openMacro)
openMacro = "-vbarun SubMenu3 "
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Sub Menu 3", openMacro)
currMenuGroup.Menus.InsertMenuInMenuBar "My Program", ""
End Sub
Sub SubMenu1()
MsgBox "Sub Menu 1"
End Sub
Sub SubMenu2()
MsgBox "Sub Menu 2"
End Sub

http://nu5.upanh.com/b6.s34.d1/e90c9e48fdba761375a1756b225cb471_52642915.untitled.700x0.jpg
Và em có một lisp có lệnh bh tạo lại boundary cho hatch bị mất như sau :

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=51566
(defun c:bh( / sl n)
(setq sl (acet-ss-to-list(ssget '((0 . "HATCH")))))
(foreach n sl
(command "hatchedit" n "b" "p" "y" "")
)
)


1.Bây giờ em muốn gán lệnh bh này vào menu Sub Menu 1 để mỗi lần kích vào nó sẽ tự động gọi lệnh bh lên thì làm như thế nào ạ?
2.Em muốn làm tiếng Việt cho menu trên thì làm như thế nào ạ?

Em nhờ các anh chị chỉ giúp ạ!
Em cảm ơn!
<<

Filename: 225256_bh.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 15767
Tên lệnh: pgp2
cánh lưu lại các phím tắt AutoCAD

bạn dùng lệnh pgp2lsp sau đây để convert file pgp hiện hành của bạn thành 1 file lisp. Sau đó copy file lisp này sang máy khác rồi appload lên rồi dùng.

Filename: 15767_pgp2.lsp
Tác giả: 790312
Bài viết gốc: 126032
Tên lệnh: is
Viết lisp theo yêu cầu [phần 2]
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.

Filename: 126032_is.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 230761
Tên lệnh: brang
xin các anh lisp bộ truyền bánh răng trụ răng thẳng!

gần giống ... anh ạ. thanks anh nhe!

Hề hề hề,

Cái ni có giống không hè???

 

(defun c:brang ( / echo oldos ort p1 m z gak goc R x y toado e1 e3 e4 e5 e6 e7 e8 e9 e10 e0 p0 p1 p2)
(vl-load-com)
(princ "\n DAY LA CHUONG TRINH VE BANH RANG THAN KHAI RANG THANG THEO Z & M")
(setq echo (getvar...
>>

gần giống ... anh ạ. thanks anh nhe!

Hề hề hề,

Cái ni có giống không hè???

 

(defun c:brang ( / echo oldos ort p1 m z gak goc R x y toado e1 e3 e4 e5 e6 e7 e8 e9 e10 e0 p0 p1 p2)
(vl-load-com)
(princ "\n DAY LA CHUONG TRINH VE BANH RANG THAN KHAI RANG THANG THEO Z & M")
(setq echo (getvar "cmdecho")  )
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode")  )
(setvar "osmode" 4287)
(setq osm (getvar "osmode")
          ort (getvar "orthomode")  )
(command "undo" "be")
(setq pt (getpoint "\n Chon vi tri tam vong tron co so")
          m (getint "\n Nhap gia tri modun m: ")
          z (getint "\n Nhap so rang: ")
          gak (getint "\n Nhap goc an khop: ")          
          goc 0.0
)
(command "ucs" "n" pt)
(command "ucs" "z" 90)
(if (not gak) (setq gak 20))
(setvar "orthomode" 0)
(command "viewres" "y" 5000)
(command "color" 1)
(setvar "osmode" 0)
(defun dtr (x) (* x (/ pi 180)))
 
(command "spline")
(repeat 46
    (setq  R (/ (* m z (cos (dtr gak))) 2)
              x (+ (* R (cos (dtr goc))) (/ (* pi R goc (sin (dtr goc))) 180))   
              y (- (* R (sin (dtr goc))) (/ (* R pi goc (cos (dtr goc))) 180)) 
             goc (1+ goc)
             toado (list x y)   )
    (command toado)
)
(command "" "" "" )
(setq e1 (entlast))
(command "color" 7)
(command "circle" '(0 0) R)
 
(command "arc" "c" '(0 0) (setq p1 (polar '(0 0) 0 (* 0.5 z m))) "angle" (* 1.5 (/ 360 z)) ) 
(setq e3 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e1 e3 0)) 0 1))
(command "break" e3 p0 p0)
(command "erase" e3 "")
(setq e3 (entlast))
(setvar "cecolor" "2")
(command "arc" "c" '(0 0) p0 "angle" (* 0.25 (/ 360 z)))
(setq e6 (entlast))
(setvar "cecolor" "7")
(command "arc" "c" '(0 0) (polar '(0 0) 0 (* (+ (* 0.5 z) 1) m)) "angle" 30)
(setq e4 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e1 e4 0)) 0 1))
(command "break" e1 p0 p0)
(command "erase" (entlast) "")
(command "break" e4 p0 p0)
(command "erase" e4 "")
(setq e4 (entlast))
(command "zoom" "e")
(command "fillet" "r" (* 0.2 m) )
(vl-cmdf ".MATCHPROP" e1 e4 "")
(command "fillet"  e1 e4)
(setq e5 (entlast))
(command "arc" "c" '(0 0) (polar '(0 0) (dtr (- (* 1.5 (/ 360 z))))  (* (- (* 0.5 z) 1.25) m)) "a" (* 1.4 (/ 360 z)))
(setq e7 (entlast))
 
(if (acet-geom-intersectwith e1 e7 2)
    (progn
         (setq p0 (trans (car (acet-geom-intersectwith e1 e7 2)) 0 1))
         (command "extend" e1 "" e7 "")
         (command "break" e1 p0 p0)
         (command "erase" e1"")
         (setq e1 (entlast))
    )
)
(if (> z 30)
    (command "fillet" "r" (* 0.4 m) )
    (command "fillet" "r" (* 1.2 (- (* 0.5 m z (cos (dtr gak))) (* 0.5 m (- z 2.5))))  )
)
(vl-cmdf ".MATCHPROP" e1 e7 "")
(command "fillet" e1 e7 "erase" e7 "")
;;(command "erase" e7 "")
(setq e7 (entlast))
(setq p0 (trans (vlax-curve-getendpoint (vlax-ename->vla-object e6)) 0 1))
(command "mirror" e5 "" p0 '(0 0) "n")
(setq e8 (entlast))
(command "mirror" e7 "" p0 '(0 0) "n")
(setq e9 (entlast))
(command "mirror" e1 "" p0 '(0 0) "n")
(setq e10 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e4 e8 0)) 0 1) )
(command "break" e4 p0 p0)
(command "erase" (entlast) "")
(command "array" e1 e10 e5 e7 e8 e4 e9 "" "p" '(0 0) z 360 "y")
(command "erase" e3 e6 "")
(setq e0 (entlast))
(setq p1 (trans (vlax-curve-getstartpoint (vlax-ename->vla-object e0)) 0 1)
          p2 (trans (vlax-curve-getendpoint (vlax-ename->vla-object e7)) 0 1) )
(setvar "cecolor" "1")
(command "arc" "c" '(0 0) p1 p2)
(setq e0 (entlast))
(command "array" e0 "" "p" '(0 0) z 360 "y")
(command "linetype" "s" "center" "")
(setvar "cecolor" "2")
(command "ltscale" 10)
(command "circle" '(0 0) (* 0.5 m z))
(command "linetype" "s" "bylayer" "")
 
(command "regen")
(command "zoom" "all")
(command "ucs" "w")
(command "undo" "e")
(setvar "osmode" osm)
(setvar "orthomode" ort)
(setvar "cmdecho" echo)
(princ)
)
(prompt "\n Go lenh Brang de bat dau chuong trinh" )

<<

Filename: 230761_brang.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 230909
Tên lệnh: brang
xin các anh lisp bộ truyền bánh răng trụ răng thẳng!

gần giống ... anh ạ. thanks anh nhe!

Hề hề hề,
Sau khi mày mò, mình tìm ra giải pháp gỡ bí cho cái lệnh fillet bằng cách xài trực tiếp trên cad để khắc phục việc fillet nhầm. Tuy nhiên người sử dụng cần lưu ý khi chọn các đối tượng để fillet phải chọn tại vị...
>>

gần giống ... anh ạ. thanks anh nhe!

Hề hề hề,
Sau khi mày mò, mình tìm ra giải pháp gỡ bí cho cái lệnh fillet bằng cách xài trực tiếp trên cad để khắc phục việc fillet nhầm. Tuy nhiên người sử dụng cần lưu ý khi chọn các đối tượng để fillet phải chọn tại vị trí gần với đỉnh cần fillet. Thao tác sử dụng lisp như sau:
1/- load lisp.
2/- gõ lệnh Brang để chạy.
3/- Nhập điểm tâm bánh răng
4/- Nhập giá trị mo dun m
5/- Nhập giá trị số răng z
6/- Nhập giá trị góc an khớp. Nếu bỏ qua lisp sẽ nhận góc ăn khớp là 20 độ
7/- Khi lisp thông báo fillet góc đỉnh rang, nhấn OK để tiếp tục
8/- Khi lisp yêu cầu chọn biên dạng thân khai, chọn điểm gần đỉnh răng trên biên dạng thân khai.
9/- Khi lisp yêu cầu chọn cung đỉnh răng, chọn điểm gần đỉnh răng trên cung tròn đỉnh răng.
10/- Làm tương tự với việc fillet chân răng.
11/- Chờ lisp hoàn thành toàn bộ vành răng.
12/- Xem và kiểm tra lại kết quả.
 
Và đây là lisp đã hoàn thiện:

 
(defun c:brang ( / echo oldos ort p1 m z gak goc R x y toado e1 e3 e4 e5 e6 e7 e8 e9 e10 e0 p0 p1 p2 ss)
(vl-load-com)
(princ "\n DAY LA CHUONG TRINH VE BANH RANG THAN KHAI RANG THANG THEO Z & M")
(setq echo (getvar "cmdecho")  )
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode")  )
(setvar "osmode" 4287)
(setq osm (getvar "osmode")
          ort (getvar "orthomode")  )
(command "undo" "be")
(setq pt (getpoint "\n Chon vi tri tam vong tron co so")
          m (getreal "\n Nhap gia tri modun m: ")
          z (getint "\n Nhap so rang: ")
          gak (getint "\n Nhap goc an khop: ")          
          goc 0.0
)
(command "ucs" "n" pt)
(command "ucs" "z" 90)
(if (not gak) (setq gak 20))
(setvar "orthomode" 0)
(command "viewres" "y" 5000)
(command "color" 1)
(setvar "osmode" 0)
(defun dtr (x) (* x (/ pi 180)))
 
(command "spline")
(repeat 46
    (setq  R (/ (* m z (cos (dtr gak))) 2)
              x (+ (* R (cos (dtr goc))) (/ (* pi R goc (sin (dtr goc))) 180))   
              y (- (* R (sin (dtr goc))) (/ (* R pi goc (cos (dtr goc))) 180)) 
             goc (1+ goc)
             toado (list x y)   )
    (command toado)
)
(command "" "" "" )
(setq e1 (entlast))
(command "color" 7)
(command "circle" '(0 0) R)
 
(command "arc" "c" '(0 0) (setq p1 (polar '(0 0) 0 (* 0.5 z m))) "angle" (* 1.5 (/ 360.0 z)) ) 
(setq e3 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e1 e3 0)) 0 1))
(command "break" e3 p0 p0)
(command "erase" e3 "")
(setq e3 (entlast))
(setvar "cecolor" "2")
(command "arc" "c" '(0 0) p0 "angle" (* 0.25 (/ 360.0 z)))
(setq e6 (entlast))
(setvar "cecolor" "7")
(command "arc" "c" '(0 0) (polar '(0 0) 0 (* (+ (* 0.5 z) 1) m)) "angle" 30)
(setq e4 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e1 e4 0)) 0 1))
(command "break" e1 p0 p0)
(command "erase" (entlast) "")
(command "break" e4 p0 p0)
(command "erase" e4 "")
(setq e4 (entlast))
(setq ss (ssadd)
          ss (ssadd e1 ss)
          ss (ssadd e4 ss) 
          p1 (car (acet-ss-zoom-extents ss))
          p2 (cadr (acet-ss-zoom-extents ss)) )
(command "zoom" "w" p1 p2)
 
(alert "\n Fillet bien dang dinh rang ")
(setvar "osmode" 512)
(command "fillet" "r" (* 0.2 m) )
(vl-cmdf ".MATCHPROP" e1 e4 "")
(command "fillet"  (entsel "\n Chon bien dang than khai <e1> ")  (entsel "\n Chon cung dinh rang <e4> ") )
(setq e5 (entlast))
(command "arc" "c" '(0 0) (polar '(0 0) (dtr (- (* 1.5 (/ 360.0 z))))  (* (- (* 0.5 z) 1.25) m)) "a" (* 1.4 (/ 360.0 z)))
(setq e7 (entlast))
 
(setq ss (ssadd)
          ss (ssadd e1 ss)
          ss (ssadd e7 ss) 
          p1 (car (acet-ss-zoom-extents ss))
          p2 (cadr (acet-ss-zoom-extents ss)) )
(command "zoom" "w" p1 p2)
(if (acet-geom-intersectwith e1 e7 2)
    (progn
         (setq p0 (trans (car (acet-geom-intersectwith e1 e7 2)) 0 1))
         (command "extend" e1 "" e7 "")
         (command "break" e1 p0 p0)
         (command "erase" e1"")
         (setq e1 (entlast))
    )
)
(alert "\n Fillet bien dang chan rang")
(if (> z 30)
    (command "fillet" "r" (* 0.4 m) )
    (command "fillet" "r" (* 1.2 (- (* 0.5 m z (cos (dtr gak))) (* 0.5 m (- z 2.5))))  )
)
(vl-cmdf ".MATCHPROP" e1 e7 "")
(command "fillet" (entsel "\n Chon bien dang than khai <e1> ") (entsel "\n Chon cung chan rang <e7> ") )
(command "erase" e7 "")
(setq e7 (entlast))
(command "zoom"  "e")
(setvar "osmode" 0)
(setq p0 (trans (vlax-curve-getendpoint (vlax-ename->vla-object e6)) 0 1))
(command "mirror" e5 "" p0 '(0 0) "n")
(setq e8 (entlast))
(command "mirror" e7 "" p0 '(0 0) "n")
(setq e9 (entlast))
(command "mirror" e1 "" p0 '(0 0) "n")
(setq e10 (entlast))
(setq p0 (trans (car (acet-geom-intersectwith e4 e8 0)) 0 1) )
(command "break" e4 p0 p0)
(command "erase" (entlast) "")
(command "array" e1 e10 e5 e7 e8 e4 e9 "" "p" '(0 0) z 360 "y")
(command "erase" e3 e6 "")
(setq e0 (entlast))
(setq p1 (trans (vlax-curve-getstartpoint (vlax-ename->vla-object e0)) 0 1)
          p2 (trans (vlax-curve-getendpoint (vlax-ename->vla-object e7)) 0 1) )
(setvar "cecolor" "1")
(command "arc" "c" '(0 0) p1 p2)
(setq e0 (entlast))
(command "array" e0 "" "p" '(0 0) z 360 "y")
(command "linetype" "s" "center" "")
(setvar "cecolor" "2")
(command "ltscale" 10)
(command "circle" '(0 0) (* 0.5 m z))
(command "linetype" "s" "bylayer" "")
 
(command "regen")
(command "zoom" "all")
(command "ucs" "w")
(command "undo" "e")
(setvar "osmode" osm)
(setvar "orthomode" ort)
(setvar "cmdecho" echo)
(princ)
)
(prompt "\n Go lenh Brang de bat dau chuong trinh" )

 
Lưy ý rằng lisp này chỉ vẽ bánh răng thân khai răng thẳng  với hệ số dịch chỉnh răng bằng 0. Trong trường hợp cần vẽ bánh răng có hệ số dịch chỉnh răng khác 0, cần hiệu chỉnh lại lisp tại các dòng code xác định bán kính vòng tròn cơ sở R, các cung chân răng, đỉnh răng cũng như vòng tròn chia của bánh răng cho phù hợp.
Chúc mọi người thành công.
<<

Filename: 230909_brang.lsp
Tác giả: duy782006
Bài viết gốc: 4054
Tên lệnh: ve0
Viết Lisp theo yêu cầu


Có cái này hôm trước thấy trên diễn đàn này nhưng bây giờ ko nhớ chổ để chỉ cho bác. Mạn phép tác giả tôi đưa lại lên cho bác dùng. Lệnh là VE0 (về không) nhớ là số 0 chứ không phải chử 0.



Còn vì sao mà cao độ không bằng nhau thì thường do các bác địa hình. Bản vẽ của các bác ấy có cao độ theo địa hình. Rồi anh em mình nhiều lấn sao chép. bắt...
>>


Có cái này hôm trước thấy trên diễn đàn này nhưng bây giờ ko nhớ chổ để chỉ cho bác. Mạn phép tác giả tôi đưa lại lên cho bác dùng. Lệnh là VE0 (về không) nhớ là số 0 chứ không phải chử 0.



Còn vì sao mà cao độ không bằng nhau thì thường do các bác địa hình. Bản vẽ của các bác ấy có cao độ theo địa hình. Rồi anh em mình nhiều lấn sao chép. bắt điểm nên dính tùm lum.
<<

Filename: 4054_ve0.lsp

Trang 124/304

124