PHẦN MỀM XÂY DỰNG
Xin vui lòng ĐĂNG NHẬP hoặc ĐĂNG KÍ để DOWNLOAD và post bài
PHẦN MỀM XÂY DỰNG
Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.
PHẦN MỀM XÂY DỰNG


Nơi lưu trữ phần mềm xây dựng, PM tiện ích
Y!M: silvurez@yahoo.com

Đăng Nhập

Quên mật khẩu



Tin Nhanh
MUZIK ONLINE
VDICT ONLINE

You are not connected. Please login or register

AUTO LISP CHO AUTO CAD

+4
okienvangs
tvgtyb08
lesitv
Admin
8 posters

Go down  Thông điệp [Trang 1 trong tổng số 1 trang]

1AUTO LISP CHO AUTO CAD Empty AUTO LISP CHO AUTO CAD Sun Apr 25, 2010 6:40 pm

Admin


Admin
Admin

Để chạy một đoạn mã lấy từ diễn đàn về:
- Nếu đoạn mã đã là 1 file lsp thì bạn chỉ việc download về và dùng chức năng appload lên để sử dụng
- Nếu đoạn mã nằm trong bài viết của diễn đàn, mở notepad (hoặc một chương trình soạn thảo nào đó cho phép bạn soạn file text) rồi paste nội dung vào. Sau đó save file này thành một file có đuôi là lsp. Sau đó appload lên dùng.
- Nếu chương trình có sử dụng file ngoài như dcl, sld, dwg thì bạn có 2 lựa chọn:
. Copy các file này vào thư mục support của AutoCAD
. Copy vào một thư mục nào đó rồi khai báo thư mục này với AutoCAD bằng cách vào Menu: Tools > Options > Files > Support file search path > Add rồi thêm đường dẫn của bạn vào.

* Để biết tên lệnh là gì?
Bạn mở file lsp ra, tìm đến các dòng mã (defun c:, phía sau c: là tên lệnh. Ví dụ: (defun c:NOILINE thì tên lệnh là NOILINE.



1. lISP SAN NỀN
[You must be registered and logged in to see this link.]



Được sửa bởi Admin ngày Sat May 15, 2010 10:19 am; sửa lần 3.

https://pmxd.forumvi.com

2AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:15 am

Admin


Admin
Admin

Tất cả các LISP CODE bạn chỉ việc copy rồi save ra file cùng tên với lệnh lisp và có phần mở rộng la .LSP (ví dụ: TaoL.LSP) là ok
Bài 1: Tạo Layer

Code:

defun c:TaoL()
(command "layer" "m" "!tuong" "c" "2" "" "")
(command "layer" "m" "!tim" "c" "1" "" "")
(command "layer" "m" "!thay" "c" "7" "" "")
(command "layer" "m" "!noithat" "c" "8" "" "")
(command "layer" "m" "!hatch" "c" "8" "" "")
(command "layer" "m" "!chu" "c" "3" "" "")
(command "layer" "m" "!kichthuoc" "c" "8" "" "")
(princ)
)
Với lisp này lệnh để tạo layer sẽ là TaoL

https://pmxd.forumvi.com

3AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:16 am

Admin


Admin
Admin

Bài 2: Tạo Text Style ( kiểu chữ )

1.
Code:
(defun c:TaoC()
(command "style" "!vnAvanH" ".VnAvantH" "" "" "" "" "")
(princ)
)
Với lisp này lệnh để tạo kiểu chữ sẽ là TaoC

https://pmxd.forumvi.com

4AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:19 am

Admin


Admin
Admin

3. lệnh để tạo kiểu kích thước sẽ là TaoK
Code:
(defun c:TaoK (/ scl fcal scal );dmasz dexo dexo dtxt dgap dclre dclrt dsn ao ad obj)
(vl-load-com)
(setq scl (getstring "\nTY LE BAN VE: "))
(setq fcal (atof (substr scl 1 1)))
(setq scal (atof (substr scl 3 3)))
(setq tyle (/ fcal scal))

(setq caochu (getint "\nCHIEU CAO CUA CHU: "))
(setvar "DIMALTF" 25)
(setvar "DIMALTTZ" 13)
(setvar "DIMALTZ" 13)
(setvar "DIMBLK" "ArchTick")
(setvar "DIMBLK1" "ArchTick")
(setvar "DIMBLK2" "ArchTick")
(setvar "DIMASZ" (/ caochu 2))
(setvar "DIMCEN" -50)
(setvar "DIMCLRD" 9)
(setvar "DIMDLE" (/ caochu 2))
(setvar "DIMTOFL" 1)
(setvar "DIMDLI" 0)
(setvar "DIMCLRE" 9)
(setvar "DIMEXE" (/ caochu 2))
(setvar "DIMEXO" 0)
(setvar "DIMTMOVE" 2)
(setvar "DIMLDRBLK" "ArchTick")
(setvar "DIMDEC" 0)
(setvar "DIMCLRT" 9)
(setvar "DIMTXT" caochu)
(setvar "DIMLFAC" TYLE)
(setvar "DIMTIX" 1)
(setvar "DIMTIH" 0)
(setvar "DIMGAP" (/ caochu 2))
(setvar "DIMTOH" 0)
(setvar "DIMTAD" 1)
(setvar "DIMTXSTY" "!vnAvanH")
(setvar "DIMTDEC" 0)
(setvar "DIMTZIN" 13)
(setvar "DIMZIN" 13)
;-------------------------------------------------------------
(setq dsn (getstring "\nTEN CUA KIEU DIM MOI: "))
(setq ao (vlax-get-acad-object))
(setq ad (vla-get-ActiveDocument ao))
(setq obj (vla-add (vla-get-dimstyles ad) dsn))
(vla-copyfrom Obj ad)
(vla-put-activedimstyle ad Obj)
(princ)
)
Các thông số cần nhập
1. Tỷ lệ bản vẽ: (Thường là 1/1, cũng có thể là 1/2 tùy vào kiểu dim bạn muốn tạo)
2. Chiều cao chữ: (Tùy thuộc vào bản vẽ của bạn)
3. Tên kiểu dim mới: (Nên đặt theo chiều cao của chữ)
Xong phần khởi động. Giờ là bắt đấu vẽ với LINE, với ARC...
- Ồ! những đường Line này sao không phải là PLINE nhỉ? Vừa dễ quản lý vừa nhẹ bản vẽ. Phải làm sao đây? BO lại à ? OH không !!!

https://pmxd.forumvi.com

5AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:20 am

Admin


Admin
Admin

Bài 4. Nối LINE và ARC thành PLINE: (nn)

Code:
(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
(defun MoPL (ssdt /)
(= (cdr (assoc '70 (entget ssdt))) 0)
)
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(command ".PEDIT" ssdt "J" "All" "" "X")
)
)
(defun NoiLC (ssdt /)
(command ".PEDIT" ssdt "Y" "J" "All" "" "X")
)
(setq
tdt (ssget)
sodt (sslength tdt)
index 0
)
(repeat sodt
(setq
ssdt (ssname tdt index)
index (1+ index)
)
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE")
)
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
)
(princ)
)

https://pmxd.forumvi.com

6AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:22 am

Admin


Admin
Admin

Bài 5: Vẽ cửa đi

a. cửa đi 1 cánh:

Code:


(defun c:c1 (/ p1 p2 p3 p4 p5 daicua x y)
(setq osm (getvar "osmode"))
(setq   p1 (getpoint "\nHay vao diem goc cua: ")

p2 (getpoint p1 "\nHay vao diem mut cua: ")
p3 (getpoint p1 "\nHay vao huong cua: ")
daicua (distance p1 p2)
x (car p1)
y (car (cdr p1))
x 25
y daicua
p4 (list x y)
p5 (list daicua 0)
)
(setvar "OSMODE" 0)
(if (l3d_khongthanghang p1 p2 p3)
(progn
(command ".UCS" "3" p1 p2 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")
)
(princ "\n3 diem nhap vao khong duoc thang hang")
)
(setvar "osmode" osm)
)

lệnh dùng trong CAD: c1

2.Cửa đi 2 cacnhs (c2)
Code:
(defun c:c2 (/ p1 p2 p3 p4 p5 daicua x y)
(setq osm (getvar "osmode"))
(setq   p1 (getpoint "\nHay vao diem goc cua: ")
p2 (getpoint p1 "\nHay vao diem mut cua: ")
p3 (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 2.0)
x (car p1)
y (car (cdr p1))
x 25
y daicua
p4 (list x y)
p5 (list daicua 0)
)
(setvar "OSMODE" 0)
(if (l3d_khongthanghang p1 p2 p3)
(progn
(command ".UCS" "3" p1 p2 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

(command ".UCS" "3" p2 p1 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

)

(princ "\n3 diem nhap vao khong duoc thang hang")
)
(setvar "osmode" osm)
)

3. Cửa đi 4 cánh(c4)
Code:

(defun c:c4 (/ p1 p2 p3 p4 p5 daicua x y)
(setq osm (getvar "osmode"))
(setq   p1 (getpoint "\nHay vao diem goc cua: ")
p2 (getpoint p1 "\nHay vao diem mut cua: ")
p3 (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 4.0)
x (car p1)
y (car (cdr p1))
x 25
y daicua
p4 (list x y)
p5 (list daicua 0)
)
(setvar "OSMODE" 0)
(if (l3d_khongthanghang p1 p2 p3)
(progn

(setq diem1 (diemgiua p1 (diemgiua p1 p2)))
(setq diem2 (diemgiua p1 p2))
(setq diem3 (diemgiua p2 (diemgiua p1 p2)))

(command ".UCS" "3" p1 p2 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

(command ".UCS" "3" diem1 p2 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

(command ".UCS" "3" p2 p1 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

(command ".UCS" "3" diem3 p1 p3)
(command ".rectangle" "0,0" p4)
(command ".Arc" p5 "C" "0,0" p4)
(command ".UCS" "P")

)

(princ "\n3 diem nhap vao khong duoc thang hang")
)
(setvar "osmode" osm)
)

https://pmxd.forumvi.com

7AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:27 am

Admin


Admin
Admin

Bài 6: Vẽ cửa sổ

Cửa sổ kiểu 1: w1
Code:

(defun c:w1(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
(setq data_m (ssget))
(setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
(setq l1 nil l2 nil check 1)
(if (not (= nil data_m)) (progn
(setq l1 (entget (ssname data_m 0)))
(setq l2 (entget (ssname data_m 1)))
(if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
(if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
(if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
(if (= 1 check) (progn
(setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
(setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
(setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
(setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
(if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
))
) (setq check 0))
(princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

(setq p3 (cdr (assoc 10 l1)))
(setq p4 (cdr (assoc 11 l1)))
(setq p5 (cdr (assoc 10 l2)))
(setq p6 (cdr (assoc 11 l2)))
(if (> (abs (- (nth 1 p1) (nth 1 p3)))
(abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
(if (> (abs (- (nth 1 p1) (nth 1 p4)))
(abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
(if (> (abs (- (nth 1 p2) (nth 1 p5)))
(abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
(if (> (abs (- (nth 1 p2) (nth 1 p6)))
(abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
(if (= 0 check) (princ "\ninvalid data") (progn
(setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
; (princ ls1)
(setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
(setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
(mkline p7 p8 l1)

(setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
; (princ ls1)
(setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
(mkline p7 p8 l1)

(setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
(mkline p7 p8 l1)

(setq getom (getvar "osmode"))
(setvar "osmode" 0)

(setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))
(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))

(setq ll1 (list
(cons 0 "line")
(cons 8 (getvar "clayer"))
))

(drawrt2 p7 p8 ll1)

(setvar "osmode" getom)
(command "erase" data_m "")

))
(princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

(setq p3 (cdr (assoc 10 l1)))
(setq p4 (cdr (assoc 11 l1)))
(setq p5 (cdr (assoc 10 l2)))
(setq p6 (cdr (assoc 11 l2)))

(if (> (abs (- (nth 0 p1) (nth 0 p3)))
(abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
(if (> (abs (- (nth 0 p1) (nth 0 p4)))
(abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
(if (> (abs (- (nth 0 p2) (nth 0 p5)))
(abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
(if (> (abs (- (nth 0 p2) (nth 0 p6)))
(abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

(if (= 0 check) (princ "\ninvalid data") (progn

(setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
; (princ ls1)
(setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
(mkline p7 p8 l1)

(setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
; (princ ls1)
(setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
(setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)

(setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)

(setq getom (getvar "osmode"))
(setvar "osmode" 0)

(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))

(setq ll1 (list
(cons 0 "line")
(cons 8 (getvar "clayer"))
))

(drawrt3 p7 p8 ll1)

(setvar "osmode" getom)
(command "erase" data_m "")


))
(princ)
)

(setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
(if (= 0 check) (princ "\ninvalid data") (progn
(if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
(nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
(if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
(nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


))

(princ)

)
(wd_import)
(ai_undo_push)
(wd_procced)
(ai_undo_pop)   
)

Cửa sổ kiểu 2 : w2

Code:
(defun c:w2(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
(setq data_m (ssget))
(setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
(setq l1 nil l2 nil check 1)
(if (not (= nil data_m)) (progn
(setq l1 (entget (ssname data_m 0)))
(setq l2 (entget (ssname data_m 1)))
(if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
(if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
(if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
(if (= 1 check) (progn
(setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
(setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
(setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
(setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
(if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
))
) (setq check 0))
(princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

(setq p3 (cdr (assoc 10 l1)))
(setq p4 (cdr (assoc 11 l1)))
(setq p5 (cdr (assoc 10 l2)))
(setq p6 (cdr (assoc 11 l2)))
(if (> (abs (- (nth 1 p1) (nth 1 p3)))
(abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
(if (> (abs (- (nth 1 p1) (nth 1 p4)))
(abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
(if (> (abs (- (nth 1 p2) (nth 1 p5)))
(abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
(if (> (abs (- (nth 1 p2) (nth 1 p6)))
(abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
(if (= 0 check) (princ "\ninvalid data") (progn
(setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
; (princ ls1)
(setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
(setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
(mkline p7 p8 l1)

(setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
; (princ ls1)
(setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
(mkline p7 p8 l1)

(setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
(setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
(mkline p7 p8 l1)

(setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))

(setq ll1 (list
(cons 0 "line")
(cons 8 (getvar "clayer"))
))

(if (< (nth 0 p1) (nth 0 ls2)) (progn
(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
(setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0))
(drawrt2 p7 p8 ll1)

(setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0))
(setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0))
(mkline p7 p8 ll1)

(setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0))
(mkline p7 p9 ll1)

(setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0))
(mkline p8 p9 ll1)
)(progn
(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
(setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0))
(drawrt2 p7 p8 ll1)

(setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0))
(setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0))
(mkline p7 p8 ll1)

(setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0))
(mkline p7 p9 ll1)

(setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0))
(mkline p8 p9 ll1)
))


(command "erase" data_m "")

))
(princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

(setq p3 (cdr (assoc 10 l1)))
(setq p4 (cdr (assoc 11 l1)))
(setq p5 (cdr (assoc 10 l2)))
(setq p6 (cdr (assoc 11 l2)))

(if (> (abs (- (nth 0 p1) (nth 0 p3)))
(abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
(if (> (abs (- (nth 0 p1) (nth 0 p4)))
(abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
(if (> (abs (- (nth 0 p2) (nth 0 p5)))
(abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
(if (> (abs (- (nth 0 p2) (nth 0 p6)))
(abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

(if (= 0 check) (princ "\ninvalid data") (progn

(setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
; (princ ls1)
(setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
(mkline p7 p8 l1)

(setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
; (princ ls1)
(setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
(setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)

(setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)
(setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
(setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
(mkline p7 p8 l1)

(setq getom (getvar "osmode"))
(setvar "osmode" 0)

(setq ll1 (list
(cons 0 "line")
(cons 8 (getvar "clayer"))
))
(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
;(princ ls2)

(if (> (nth 1 p1) (nth 1 ls2)) (progn

(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
(setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

(drawrt3 p7 p8 ll1)

(setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0))
(setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0))
(mkline p7 p8 ll1)

(setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0))
(mkline p7 p9 ll1)

(setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0))
(mkline p8 p9 ll1)
)(progn
(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
(setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

(drawrt3 p7 p8 ll1)


(setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0))
(setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0))
(mkline p7 p8 ll1)

(setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0))
(mkline p7 p9 ll1)

(setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0))
(mkline p8 p9 ll1)


))

(setvar "osmode" getom)

(command "erase" data_m "")


))
(princ)
)

(setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
(if (= 0 check) (princ "\ninvalid data") (progn
(if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
(nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
(if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
(nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


))

(princ)

)
(wd_import)
(wd_procced)
)

https://pmxd.forumvi.com

8AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 26, 2010 9:28 am

Admin


Admin
Admin

Bài 7: Offset line sang 2 bên

LỆNH: oo
Code:
(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))

(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)

(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))

))
(princ)
)

(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)

Lênh để offset line sang 2 bên là oo.

https://pmxd.forumvi.com

9AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Apr 27, 2010 8:27 am

Admin


Admin
Admin

Bài 9: Nối 2 đường Line bị ngặt quãng


LENH: jl

Code:

(defun c:jl (/ p1 p2 p3 ssdt entla entlb tt p1a p2a tt p1b p2b layermoi TAPLINEMOI TENLAYERMOI)
(defun thanghang (p0 p1 p2 / dx1 dy1 dx2 dy2 x1 y1 x2 y2 x0 y0)
(setq
x0 (car p0)
y0 (cadr p0)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
dx1 (- x1 x0)
dy1 (- y1 y0)
dx2 (- x2 x0)
dy2 (- y2 y0)
)
(if   (equal (* dx1 dy2) (* dx2 dy1) 0.01)
t
nil
)
)
(defun noiline (p1 p2 p3 p4 / kq dmax)
(if   (and (thanghang p1 p2 p3) (thanghang p1 p2 p4))
(progn
(setq d1 (distance p1 p3)
d2 (distance p1 p4)
d3 (distance p2 p3)
d4 (distance p2 p4)
dmax (max d1 d2 d3 d4)
kq (cond
((= dmax d1) (list p1 p3))
((= dmax d2) (list p1 p4))
((= dmax d3) (list p2 p3))
((= dmax d4) (list p2 p4))
(t nil)
)
)
kq
)
nil
)
)
(init)
(setq
p1    (getpoint "\ngocdau: ")
p2    (getcorner p1 "\ngocsau: ")
ssdt (ssget "c" p1 p2 '((0 . "LINE")))
entla (ssname ssdt 0)
entlb (ssname ssdt 1)
tt    (entget entla)
p1a    (cdr (assoc 10 tt))
p2a    (cdr (assoc 11 tt))
tt    (entget entlb)
p1b    (cdr (assoc 10 tt))
p2b    (cdr (assoc 11 tt))
tenlayermoi (cdr (assoc 8 (entget entla)))
)
(if (setq taplinemoi (noiline p1a p2a p1b p2b))
(progn
(command ".erase" ssdt "")
(entmake
(list
(cons 0 "LINE")
(cons 8 tenlayermoi)
(cons 10 (car taplinemoi))
(cons 11 (cadr taplinemoi))
)
)
(traos)
)
(princ "\nKhong the noi line duoc !")
)
(done)
)

https://pmxd.forumvi.com

10AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Apr 27, 2010 9:07 am

Admin


Admin
Admin

Bài 10: Hiệu chỉnh Hatch


Code:

(defun c:hc ()
(setq elist   (entget (car (entsel "\nLUA CHON MAU HATCH DE SAO CHEP: ")))
etyp   (cdr (assoc 0 elist))
old (getvar "clayer")
);setq

(if (/= etyp "HATCH")
(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")
(progn
(setq layn (cdr (assoc 8 elist)))
(setvar "HPNAME" (cdr (assoc 2 elist)))
(setvar "HPSCALE" (cdr (assoc 41 elist)))
(setvar "HPANG" (cdr (assoc 52 elist)))
(setq pt1 (getpoint "\nCHON MOT DIEM TRONG VUNG SE HATCH: "))
(setvar "clayer" layn)
(command "bhatch" pt1 "")
(setvar "clayer" old)
);progn
);if
(princ)
);defun
;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******
(defun c:hm ()
(setq ename   (entsel "\nLUA CHON MAU HATCH DE DI CHUYEN: ")
elist (entget (car ename))
etyp   (cdr (assoc 0 elist))
old (getvar "clayer")
);setq

(if (/= etyp "HATCH")
(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")
(progn
(setq layn (cdr (assoc 8 elist)))
(setvar "HPNAME" (cdr (assoc 2 elist)))
(setvar "HPSCALE" (cdr (assoc 41 elist)))
(setvar "HPANG" (cdr (assoc 52 elist)))
(setq pt1 (getpoint "\nCHON MOT DIEM TRONG VUNG SE HATCH: "))
(setvar "clayer" layn)
(entdel (car ename))
(command "bhatch" pt1 "")
(setvar "clayer" old)
);progn
);if
(princ)
);defun
;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******
(defun c:ha    ()
(setq ename(entsel "\nLUA CHON MAU HATCH DE THAY DOI GOC : ")
elist(entget (car ename))
etyp(cdr (assoc 0 elist))
oang(assoc 52 elist)
);setq

(if (/= etyp "HATCH")
(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")
(progn
(setq ang (getangle (strcat "\nSO DO GOC MOI <" (rtos (cdr oang) 2) ">:"))
nang (cons 52 ang)
nlst (subst nang oang elist)
)
(entmod nlst)
(command "hatchedit" ename "" "" "" "")
);progn
);if
(princ)
);defun
;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******
(defun c:hs    ()
(setq ename   (entsel "\nLUA CHON MAU HATCH DE THAY DOI TY LE : ")
elist (entget (car ename))
etyp   (cdr (assoc 0 elist))
oscl (assoc 41 elist)
);setq

(if (/= etyp "HATCH")
(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")
(progn
(setq hscl (getreal (strcat "\nTY LE MAU HATCH MOI <" (rtos (cdr oscl) 2) ">:"))
nscl (cons 41 hscl)
nlst (subst nscl oscl elist)
)
(entmod nlst)
(command "hatchedit" ename "" "" "" "")
);progn
);if
(princ)
);defun

Trong lisp này cung cấp cho chúng ta những lệnh sau
1. hc: Copy Hatch
1. hm: Move Hatch
1. ha: Chỉnh góc của mấu Hatch
1. hs: Chỉnh độ Scale của mẫu Hatch

https://pmxd.forumvi.com

11AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Jun 08, 2010 10:56 am

Admin


Admin
Admin

Lisp1 (joint2pline.lsp) : lệnh tắt là NN, dùng nối các line với nhau (thay cho lệnh pedit, rất tiện lợi)
Lisp2 (CD_BD PMH.lsp) : lệnh tắt là CD , dùng để chỉnh sửa các dim, rất có ích cho việc trình bày bản vẽ


[You must be registered and logged in to see this link.]

https://pmxd.forumvi.com

12AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Jun 08, 2010 10:57 am

Admin


Admin
Admin

Lisp vẽ đuờng vuông góc với 1 đường cho trươc

[You must be registered and logged in to see this link.]

https://pmxd.forumvi.com

13AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Thu Sep 09, 2010 12:53 am

lesitv



không cần nữa



Được sửa bởi lesitv ngày Mon Sep 13, 2010 12:02 pm; sửa lần 1. (Reason for editing : kg cần nữa)

14AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Fri Apr 01, 2011 5:57 pm

tvgtyb08



Code bài 3 và bài 9 ko dùng được bác ơi.

http://taybac.1talk.net

15AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Mon Apr 25, 2011 10:41 am

okienvangs



Ở bài 2 (tạo kiểu Text) mình muốn tạo nhiều kiểu text trong 1 lisp thì sao hả bạn?
Ở bài 3 (tạo Dim) mình muốn thay Block: ArchTick thành Closed filled và ở Tab Primary Units> Scale factor: 1 thành 100 (mình sử dụng đơn vị centimet).
Đa tạ bạn!

16AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Fri May 13, 2011 11:27 am

vuhailong1976



Tôi muốn tạo một lisp với nội dung sau:chỉnh sửa hatch đã có, chỉnh sửa góc lấy số liệu từ một đoạn thẳng cho trước, chỉnh sửa gốc hatch bắt một điểm trong bản vẽ. Kính mong mọi người giúp đỡ.

17AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Aug 16, 2011 10:45 am

tanbqtb03



Admin đã viết:Để chạy một đoạn mã lấy từ diễn đàn về:
- Nếu đoạn mã đã là 1 file lsp thì bạn chỉ việc download về và dùng chức năng appload lên để sử dụng
- Nếu đoạn mã nằm trong bài viết của diễn đàn, mở notepad (hoặc một chương trình soạn thảo nào đó cho phép bạn soạn file text) rồi paste nội dung vào. Sau đó save file này thành một file có đuôi là lsp. Sau đó appload lên dùng.
- Nếu chương trình có sử dụng file ngoài như dcl, sld, dwg thì bạn có 2 lựa chọn:
. Copy các file này vào thư mục support của AutoCAD
. Copy vào một thư mục nào đó rồi khai báo thư mục này với AutoCAD bằng cách vào Menu: Tools > Options > Files > Support file search path > Add rồi thêm đường dẫn của bạn vào.

* Để biết tên lệnh là gì?
Bạn mở file lsp ra, tìm đến các dòng mã (defun c:, phía sau c: là tên lệnh. Ví dụ: (defun c:NOILINE thì tên lệnh là NOILINE.



1. lISP SAN NỀN
[You must be registered and logged in to see this link.]
bạn cho mình hỏi tên lệnh của lisp này là gì vây? bạn đóng gói ở dạng .fas nên mình ko biết được tên lệnh để sử dụng, thanks bạn nhiều!

18AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Tue Mar 06, 2012 11:44 pm

vnspirit



các lisp vẽ cửa thực hiện sao bác admin,sao tthuc hanh ma ko dc?thanks

19AUTO LISP CHO AUTO CAD Empty Re: AUTO LISP CHO AUTO CAD Wed Nov 19, 2014 4:18 pm

dovantrung992



các anh ơi em muốn học tạo 1 file lisp.trước tiên mình phải học từ đâu vậy mấy anh.

Sponsored content



Về Đầu Trang  Thông điệp [Trang 1 trong tổng số 1 trang]

Permissions in this forum:
Bạn không có quyền trả lời bài viết