31/03/2026

Lisp miễn phí vẽ lưới tọa độ VN2000 | LUOI edited by lisp.vn | AutoLISP Reviewer

Ứng dụng được chỉnh sửa/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản
   

Thông tin thêm: 👉👉👉

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)



---------------------------------------------------------------------------------------------
Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

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

Lisp miễn phí vẽ lưới tọa độ VN2000 | LUOI edited by lisp.vn | AutoLISP Reviewer

Ứng dụng được chỉnh sửa/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản     Thông tin thêm: 👉👉👉