这个程序的目的是在平面上画出矩形区域，并将这些矩形的位置和大小写在文件里。
(defun c:tt()
;
(setq all_data '())
; Define the original point
(setq pt0 nil)
(while (not pt0)
(setq pt0 (getpoint "\n Define the original point"))
)
; Define the two corners of rectangle
(setq pt1 (getpoint "\nThe first corner of rectangle"))
(if (not pt1)
; when pt1 is not available
(setQ pt2 nil)
; when pt1 is available
(setq pt2 (getcorner pt1 "\nThe other corner of rectangle"))
)
(setq num 0)
; save the osmode
(setq oldsanp (getvar "osmode"))
(while (and pt1 pt2)
;set osmode = 0 for accurate plot
(setvar "osmode" 0)
; Plot rectangle
(command "rectang" pt1 pt2)
(setq pc (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)))
; Plot circle
(command "circle" pc 800)
; Marked with NO.
(setq num (1+ num))
(command "text" "m" pc 800 0 (itoa num))
; reset the osmode
(setvar "osmode" oldsanp)
; Define coordinate of the rectangle center: pcx, pcy
(setq pcx (- (/ (+ (car pt1) (car pt2)) 2) (car pt0))
pcy (- (/ (+ (cadr pt1) (cadr pt2)) 2) (cadr pt0))
)
; Define the X or Y ranges of the rectangle: dx, dy
(setq dx (abs (- (car pt1) (car pt2)))
dy (abs (- (cadr pt1) (cadr pt2)))
)
(prin1)
; Store information in all_data
(setq all_data (cons (list pcx pcy dx dy) all_data))
; Define the two corners of rectangle
(setq pt1 (getpoint "\nThe first corner of rectangle"))
(if (not pt1)
; when pt1 is not available
(setq pt2 nil)
; when pt1 is available
(setq pt2 (getcorner pt1 "\nThe other corner of rectangle"))
)
(prin1)
)
; Reverse the list
(setq all_data (reverse all_data))
; write file
(setq dat_file (getfiled "Save file as" "C:\\tempfile" "csv" 1))
(setq fo (open dat_file "w"))
(write-line "NO., pcx, pcy, dx, dy" fo)
; element index start from 0
(setq n (length all_data)
i 0
)
(repeat n
(setq data (nth i all_data))
(write-line (strcat (itoa (1+ i)) ", "
(rtos (/ (nth 0 data) 1000) 2 3) ", "
(rtos (/ (nth 1 data) 1000) 2 3) ", "
(rtos (/ (nth 2 data) 1000) 2 3) ", "
(rtos (/ (nth 3 data) 1000) 2 3)
)
fo
)
(setq i (1+ i))
)
(close fo)
(princ (strcat "\nWrite file:" dat_file))
(prin1)
)
(princ "Shortcut: TT")
