Lệnh sử dụng GRA1

Áp dụng cho AutoCAD >= 2007

Tùy chọn:

Textheight Chiều cao Text

C1 Số chữ số thập phân Tọa độ

C2 Số chữ số thập phân Chiều dài

Sau khi pick tọa độ xong, toàn bộ dữ liệu được Copy tự động vào Clipboard. Sang Excel sử dụng Ctrl+V để Paste dữ liệu!

1 Thêm lisp GRA1_.lsp

Lưu mã sau dưới dạng tệp tin GRA1_.lsp

Code:

;;;
;;;  System variable save
;;;
(defun modes (a)
  (setq mlst '())
  (repeat (length a)
    (setq mlst (append mlst (list (list (car a) (getvar (car a))))))
    (setq a (cdr a)))
)
;;;
;;;  System variable restore
;;;
(defun moder ()
  (repeat (length mlst)
    (setvar (caar mlst) (cadar mlst))
    (setq mlst (cdr mlst))
  )
)
;;;


(defun at_err (st)
  (if (and (/= st "Function cancelled") 
           (/= st "quit / exit abort")
       )
    (princ (strcat "\nError: " st))
  ) 
  (moder)
  (setq *error* olderr)
  (princ)
) 
(defun SetClipText (str / html result)
	(if (= 'STR (type str))
		(progn
			(setq html (vlax-create-object "htmlfile")
				result (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" str))
			(vlax-release-object html)
		   str
		)
	)
)
;;;
;;; -------------------------- MAIN PROGRAM ----------------------------------
;;;
(defun DPL (pt1 pt2 c2 textheight / ss ent elist points i pt1 pt2 len ang ang-deg txtpt dimtxt textheight offset rot)	
	(defun midpoint (p1 p2)
		(mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
	)

	(defun get-vertex-list (e)
	(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) e)))

	;(setq textheight Textheight)  
	(setq offset (* textheight 1.2))

	(setq len (distance pt1 pt2))
	(setq ang (angle pt1 pt2))
	(setq ang-deg (* ang (/ 180.0 pi)))
	(setq rot (if (and (>= ang-deg 90.0) (< ang-deg 270.0)) (+ ang pi) ang))

	(setq txtpt (polar (midpoint pt1 pt2) (+ ang (/ pi 2)) offset))
	(setq dimtxt (rtos len 2 c2))

	;(prompt (strcat "\n? Ðo?n " (itoa i) ": " dimtxt))

	(entmake
		(list
			(cons 0 "TEXT")
			(cons 8 "DIM_TEXT")
			(cons 1 dimtxt)
			(cons 10 txtpt)
			(cons 11 txtpt)
			(cons 40 textheight)
			(cons 50 rot)
			(cons 72 4)
			(cons 73 2)
		)
	)
)
(defun c:GRA1 ( / pt1 xpt1 xpt2 xpt3 xpt4 ypt1 slx1 slx2 nlx1 nlx2 pt spt dist)
	(defun sleep_osnap ()(setvar "OSMODE" (logior (getvar "OSMODE") 16384)))
	(defun wake_osnap ()(setvar "OSMODE" (logand (getvar "OSMODE") -16385)))
	
	(setq olderr *error* *error* at_err)
	(modes '("CMDECHO" "HIGHLIGHT" "osmode"))
	;(mapcar 'setvar '("CMDECHO" "HIGHLIGHT" "osmode") '(0 0 0))
	(command "._undo" "_g")
	(if (not (tblsearch "style" "vntime"))
	(command "_.style" "vntime" ".vntime" "" "" "" "" ""))
	(if (not (tblsearch "layer" "ghichu"))
	(command "_.layer" "m" "ghichu" "c" "4" "ghichu" "" ""))
	(if (eq nil c1) (setq c1 3))
	(if (eq nil c2) (setq c2 2))
	(if (eq nil Textheight) (setq Textheight 1.2))
	
	(initget (setq init "Textheight C1 C2"))
	(setq conti (setq pt1 (getpoint "\nChon diem ghi khung toa do [Textheight/C1/C2]: ")))
	(while (not (listp pt1))
		(princ pt1)
		(if (eq pt1 "C1")
			(progn
				(if (setq c (getint "\nSo chu so thap phan Toa do:")) (setq c1 c))
			)
			(if (eq pt1 "C2")
				(progn
					(if (setq c (getint "\nSo chu so thap phan Chieu dai:")) (setq c2 c))
				)
				(if (eq pt1 "Textheight")
					(progn
						(if (setq c (getreal "\nChieu cao chu:")) (setq Textheight c))
					)
				)
			)
		)
		
		(initget (setq init "Textheight C1 C2"))
		(setq pt1 (getpoint "\nChon diem ghi khung toa do [Textheight/C1/C2]: "))
	)
	(if (eq nil pt1) (exit))
	
	(setq xpt1 (car pt1) ypt1 (cadr pt1))
	(setq xpt2 (+ xpt1 12) xpt3 (+ xpt1 23) xpt4 (+ xpt1 31))
	(setq slx1 (list (- xpt1 4) (+ ypt1 8))
		slx2 (list (+ xpt4 2) (+ ypt1 8)))
		
	(sleep_osnap)
	(command "_.line" slx1 slx2 "")
	(command "_.line" (list (+ xpt1 2) (+ ypt1 5)) (list (+ xpt3 2) (+ ypt1 5)) "")
	(command "_.line" (list (- xpt1 4) (+ ypt1 2)) (list (+ xpt4 2) (+ ypt1 2)) "")
	(command "_.text" "_J" "_C" (list (- xpt1 1) (+ ypt1 4.5)) 1 "0" "STT")
	(command "_.text" "_J" "_C" (list (+ xpt2 2) (+ ypt1 6.0)) 1 "0" "T\U+1ECDa \U+0111\U+1ED9")
	(command "_.text" "_J" "_C" (list (- xpt2 4.0) (+ ypt1 3.0)) 1 "0" "X (m)")
	(command "_.text" "_J" "_C" (list (- xpt3 3.5) (+ ypt1 3.0)) 1 "0" "Y (m)")
	(command "_.text" "_J" "_C" (list (- xpt4 2.0) (+ ypt1 5.5)) 1 "0" "K/cách")
	(command "_.text" "_J" "_C" (list (- xpt4 2.0) (+ ypt1 3.5)) 1 "0" "(m)")
	
	(wake_osnap)
	
	(setq str "")
	(setq j 1)
	(prompt "\nDiem thu nhat: ")
	;(setvar "osmode" 1)
	(setq p1 (list))
	(while (setq pt (getpoint))
		(if pt
			(progn
				(if (not p1) (setq p1 pt))
				(sleep_osnap)
				(setq xpt (rtos (car pt) 2 c1) ypt (rtos (cadr pt) 2 c1))
				(command "_.text" "_J" "_R" (list xpt1 ypt1) 1 "0" (itoa j))
				(command "_.text" "_J" "_R" (list xpt2 ypt1) 1 "0" ypt)
				(command "_.text" "_J" "_R" (list xpt3 ypt1) 1 "0" xpt)
				(if spt
					(progn
						(setq dist (rtos (distance spt pt) 2 c2))
						(command "_.text" "_J" "_R" (list xpt4 (+ ypt1 1.5)) 1 "0" dist)
						(setq str (strcat str dist))
						(DPL spt pt c2 Textheight)
					)
				)
				(setq str (strcat (if (eq str "") str (strcat str "\n")) (itoa j) "\t" ypt "\t" xpt "\t"))
				(command "_.donut" "0" (* Textheight 0.7) pt "")
				(command "_.TEXT" (list (+ (car pt) 1.0) (cadr pt)) (* 1.25 Textheight) "0" (itoa j))
				(setq nlx1 (list (- xpt1 4) (- ypt1 1))
					nlx2 (list (+ xpt3 2) (- ypt1 1)))
				(command "_.line" nlx1 nlx2 "")
				(setq spt pt ypt1 (- ypt1 3))
				(princ "\nDiem thu ") (princ (setq j (1+ j))) (prompt " : ")
				
				(wake_osnap)
			)
		) ; end if pt
	)
	
	(if p1
		(progn
			(setq pt p1)
			(sleep_osnap)
			(setq xpt (rtos (car pt) 2 c1) ypt (rtos (cadr pt) 2 c1))
			(command "_.text" "_J" "_R" (list xpt1 ypt1) 1 "0" (itoa 1))
			(command "_.text" "_J" "_R" (list xpt2 ypt1) 1 "0" ypt)
			(command "_.text" "_J" "_R" (list xpt3 ypt1) 1 "0" xpt)
			(if spt
				(progn
					(setq dist (rtos (distance spt pt) 2 c2))
					(command "_.text" "_J" "_R" (list xpt4 (+ ypt1 1.5)) 1 "0" dist)
					(setq str (strcat str dist))
					(DPL spt pt c2 Textheight)
				)
			)
			(setq str (strcat (if (eq str "") str (strcat str "\n")) (itoa 1) "\t" ypt "\t" xpt "\t"))
			
			(setq nlx1 (list (- xpt1 4) (- ypt1 1))
				nlx2 (list (+ xpt3 2) (- ypt1 1)))
			(command "_.line" nlx1 nlx2 "")
			(setq spt pt ypt1 (- ypt1 3))
			(princ "\nDiem thu ")
			(princ (setq j (1+ j)))
			(prompt " : ")
			(wake_osnap)
		)
	)
	
	(sleep_osnap)
	(command "_.line" slx1 nlx1 "")
	(command "_.line" slx2 (list (+ xpt4 2) (+ ypt1 2)) nlx2
	(list (+ xpt3 2) (cadr slx1)) "")
	(command "_.line" (list (+ xpt2 2) (- (cadr slx1) 3)) (list (+ xpt2 2) (cadr nlx1)) "")
	(command "_.line" (list (+ xpt1 2) (cadr slx1)) (list (+ xpt1 2) (cadr nlx1)) "")
	(command "._undo" "_e")
	(wake_osnap)
	(moder)
	(setq *error* olderr)
	(princ "\nData was copied to the Clipboard\n")
	(princ str)
	(SetClipText str)
	(princ "\nCombined and Edited by lisp.vn")
	(princ "\nFree share on lisp.vn")
	(princ)
)
(vl-load-com)