Lệnh LUOI
Vẽ lưới tọa độ Grid ngay trong Model
1 Thêm lisp Luoi_edited_by_AJS.lsp
Lưu mã sau dưới dạng tệp tin Luoi_edited_by_AJS.lsp
Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:luoi( / k k1 k2 st X Xt Xd Y Yt Yd p1 p2 p3 old oold)
(princ "\nChuong trinh ve luoi toa do VN2000 - Edited by lisp.vn\n")
(if (null (tblsearch "style" "vaptimn"))
(if (> (atof (getvar "ACADVER")) 19)
(command "_style" "vaptimn" "Arial.ttf" "" "" "" "" "" "")
(command "_style" "vaptimn" "Arial.ttf" "" "" "" "" "" "" "")
)
)
(setq old (getvar "textstyle"))
(setq oold (getvar "osmode"))
(setvar "osmode" 513)
(setq r (getvar "USERR1"))
(if (< r 10) (setq r 2000))
(setq TileBd (getint (strcat "\nMau So Ti Le Cua Ban Ve " "(" (rtos r 2 0) "):")))
(if (= TileBd nil)
(setq TileBd r))
(setvar "USERR1" TileBd)
(initget "Y")
(setq opt (getkword "\nBan do co xoay khung khong? <N>: "))
(setq p1 (getpoint "\nDiem dau (goc khung): "))
(setq z1 (getcorner p1 "\nDiem cuoi(goc khung): "))
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x2 (car z1))
(setq y2 (cadr z1))
(setq na (abs(- x2 x1)))
(setq do (abs(- y2 y1)))
(setq onale (/ na (/ TileBD 10)))
(setq odole (/ do (/ TileBD 10)))
(setq ona (fix onale))
(setq odo (fix odole))
(setq LayerOld (getvar "clayer"))
(if (null (tblsearch "layer" "luoi"))
(command "_layer" "m" "luoi" ""))
(command "_layer" "s" "luoi" "")
(command "_layer" "c" "5" "luoi" "")
(setvar "osmode" 0)
(setq k (/ (cadr p1) (/ TileBd 10)))
(setq b (rtos (cadr p1) 2 0))
(setq c (rtos (car p1) 2 0))
(setq k1 (rtos k 2 0))
(if (< (atoi k1) k)
(progn
(setq k11 (+ (atoi k1) 1))
(setq k1 (rtos k11 2 0))
)
)
(setq k2 (* (/ TileBd 10) (atoi k1)))
(setq p3 (list (car p1) k2 0.0))
(setq st (strcat (substr b 6 1) (substr b 7 1)))
(if (= opt nil)
(progn
(setq i (+ odo 1))
(setq ngang (/ onale 10))
(setq doc (/ odole 10))
(if (> (- k2 (cadr p1)) (* 0.03 TileBd))
(setq i odo)
)
)
)
(if (/= opt nil)
(progn
(setq ngang (/ odole 10))
(setq doc (/ onale 10))
(setq i (+ ona 1))
(if (> (- k2 (cadr p1)) (* 0.02 TileBd))
(setq i ona)
)
)
)
(setq m 1)
(setq ii i)
(while (<= m i)
(progn
(setq X (rtos (cadr p3) 2 0))
(setq Xt (strcat (substr X 1 1) (substr X 2 1) (substr X 3 1) (substr X 4 1)))
(setq Xd (strcat (substr X 5 1) (substr X 6 1) (substr X 7 1)))
(setq p31 (list (* -0.01 TileBd) 0 0))
(setq p41 (list (* 0.005 TileBd) (* 0.001 TileBd) 0))
(setq p51 (list (* 0.005 TileBd) (* -0.003 TileBd) 0))
(setq p4 (mapcar '+ p3 p31))
(setq p5 (mapcar '+ p4 p41))
(setq p6 (mapcar '+ p4 p51))
(command "_line" p4 p3 "")
(if (= opt nil)
(progn
(command "_text" "s" "vaptimn" "j" "C" p5 (* 0.002 TileBd) "0" Xt)
(command "_text" "s" "vaptimn" "j" "C" p6 (* 0.002 TileBd) "0" Xd)
)
)
(if (/= opt nil)
(progn
(setq p41 (list (* 0.003 TileBd) 0 0))
(setq p41 (mapcar '+ p4 p41))
(command "_text" "s" "vaptimn" "j" "R" p41 (* 0.002 TileBd) "90" (strcat Xt " "))
(command "_text" "s" "vaptimn" p41 (* 0.002 TileBd) "90" (strcat " " Xd))
)
)
(setq p31 (list (* ngang TileBd) 0 0))
(setq p33 (mapcar '+ p3 p31))
(setq p44 (mapcar '+ p4 p31))
(setq p55 (mapcar '+ p5 p31))
(setq p66 (mapcar '+ p6 p31))
(command "_line" p44 p33 "")
(if (= opt nil)
(progn
(command "_text" "s" "vaptimn" "j" "C" p55 (* 0.002 TileBd) "0" Xt)
(command "_text" "s" "vaptimn" "j" "C" p66 (* 0.002 TileBd) "0" Xd)
)
)
(if (/= opt nil)
(progn
(setq p331 (list (* -0.001 TileBd) 0 0))
(setq p331 (mapcar '+ p33 p331))
(command "_text" "s" "vaptimn" "j" "R" p331 (* 0.002 TileBd) "90" (strcat Xt " "))
(command "_text" "s" "vaptimn" p331 (* 0.002 TileBd) "90" (strcat " " Xd))
)
)
(setq p31 (list 0 (* 0.1 TileBd) 0))
(setq p3 (mapcar '+ p3 p31))
(setq m (+ 1 m))
)
)
(setq j (/ (car p1) (/ TileBd 10)))
(setq j1 (rtos j 2 0))
(if (< (atoi j1) j)
(progn
(setq j11 (+ (atoi j1) 1))
(setq j1 (rtos j11 2 0))
)
)
(setq j2 (* (* 0.1 TileBd) (atoi j1)))
(setq q3 (list j2 (cadr p1) 0.0))
(setq st (strcat (substr c 5 1) (substr c 6 1)))
(if (= opt nil)
(progn
(setq ngang (/ onale 10))
(setq doc (/ odole 10))
(setq i (+ ona 1))
(if (> (- j2 (car p1)) (* 0.02 TileBd))
(setq i ona)
)
)
)
(if (/= opt nil)
(progn
(setq ngang (/ odole 10))
(setq doc (/ onale 10))
(setq i (+ odo 1))
(if (> (- j2 (car p1)) (* 0.03 TileBd))
(setq i odo)
)
)
)
(setq m 1)
(setq jj i)
(while (<= m i)
(progn
(setq Y (rtos (car q3) 2 0))
(setq Yt (strcat (substr Y 1 1) (substr Y 2 1) (substr Y 3 1)))
(setq Yd (strcat (substr Y 4 1) (substr Y 5 1) (substr Y 6 1)))
(setq q31 (list 0 (* -0.01 TileBd) 0))
(setq q41 (list 0 (* 0.0005 TileBd) 0))
(setq q4 (mapcar '+ q3 q31))
(setq q5 (mapcar '+ q4 q41))
(command "_line" q4 q3 "")
(if (= opt nil)
(progn
(command "_text" "s" "vaptimn" "j" "R" q5 (* 0.002 TileBd) "0" (strcat Yt " "))
(command "_text" "s" "vaptimn" q5 (* 0.002 TileBd) "0" (strcat " " Yd))
)
)
(if (/= opt nil)
(progn
(setq q555 (list (* -0.001 TileBd) (* 0.005 TileBd) 0))
(setq q666 (list (* 0.003 TileBd) (* 0.005 TileBd) 0))
(setq q5551 (mapcar '+ q5 q555))
(setq q6661 (mapcar '+ q5 q666))
(command "_text" "s" "vaptimn" "j" "C" q5551 (* 0.002 TileBd) "90" Yt)
(command "_text" "s" "vaptimn" "j" "C" q6661 (* 0.002 TileBd) "90" Yd)
)
)
(setq q31 (list 0 (* doc TileBd) 0))
(setq q41 (list 0 (* (+ doc 0.0065) TileBd) 0))
(setq q33 (mapcar '+ q3 q31))
(setq q44 (mapcar '+ q4 q31))
(setq q55 (mapcar '+ q5 q41))
(command "_line" q44 q33 "")
(if (= opt nil)
(progn
(command "_text" "s" "vaptimn" "j" "R" q55 (* 0.002 TileBd) "0" (strcat Yt " "))
(command "_text" "s" "vaptimn" q55 (* 0.002 TileBd) "0" (strcat " " Yd))
)
)
(if (/= opt nil)
(progn
(setq q555 (list (* -0.001 TileBd) (* 0.005 TileBd) 0))
(setq q666 (list (* 0.003 TileBd) (* 0.005 TileBd) 0))
(setq q5551 (mapcar '+ q44 q555))
(setq q6661 (mapcar '+ q44 q666))
(command "_text" "s" "vaptimn" "j" "C" q5551 (* 0.002 TileBd) "90" Yt)
(command "_text" "s" "vaptimn" "j" "C" q6661 (* 0.002 TileBd) "90" Yd)
)
)
(setq q31 (list (* 0.1 TileBd) 0 0))
(setq q3 (mapcar '+ q3 q31))
(setq m (+ 1 m))
)
)
(setq tl TileBd)
(setq goc (list j2 k2 0))
(setq gocd goc)
(setq n 1)
(while (<= n ii)
(progn
(setq m 1)
(setq gocn gocd)
(while (<= m jj)
(progn
(setq r gocn)
(setq r1 (list (* -0.0025 tl) 0 0))
(setq r2 (list (* 0.0025 tl) 0 0))
(setq r3 (list 0 (* -0.0025 tl) 0))
(setq r4 (list 0 (* 0.0025 tl) 0))
(setq r11 (mapcar '+ r r1))
(setq r22 (mapcar '+ r r2))
(setq r33 (mapcar '+ r r3))
(setq r44 (mapcar '+ r r4))
(command "_line" r11 r22 "")
(command "_line" r33 r44 "")
(setq aa (list (* 0.1 tl) 0 0))
(setq gocn (mapcar '+ gocn aa))
(setq m (+ 1 m))
)
)
(setq bb (list 0 (* 0.1 tl) 0))
(setq gocd (mapcar '+ gocd bb))
(setq n (+ 1 n))
)
)
(setvar "clayer" LayerOld)
(setvar "osmode" oold)
(princ "\nEdited by lisp.vn\n")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Link tải (MediaFire)
---------------------------------------------------------------------------------------------
Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!
Cảm ơn bạn đã theo dõi!

Không có nhận xét nào:
Đăng nhận xét