; This function automates horizontal & vertical column grid lines at specified
; offsets. A column line bubble with number or letter is placed at the end of
; each centerline. Numbers or letters are sequentially incremented at each
; centerline. Dimension is performed between each column line.
; The orientation is bubbles on top and to the left of centerlines.
; Offsets top to bottom and left to right.
; Orginal program by Jeff Burner
; Slightly modified by Igal Averbuh 2017 (added option to set needful data by 2 points on screen)

(defun c:cg ()
(alert "Need to disable WinHEB in order to use this routine properly")
(setvar 'TEXTSIZE
(cond ((getdist (strcat "\nSpecify Text Height by 2 points : ")))
((getvar 'TEXTSIZE))
)
)

(setq CE (getvar "CMDECHO")
OM (getvar "ORTHOMODE")
TS (getvar "TEXTSIZE")
TH (rtos TS)
)

(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 0)
(if TS
(progn
(setq TXTHT (strcat "\nText Height: "))
(setq THT (atof (getstring TXTHT)))
(if (= THT 0.0) (setq STTXT TS) (setq STTXT THT))
)
)
(setq P1 (getpoint "\nEnter upper left grid intersection: "))
(setq XBAYN (getint "\nEnter no. of horizontal axes: "))
(setq YBAYN (getint "\nEnter no. of vertical axes: "))
(setq XBAYZ (getdist "\nEnter horizontal distance between axes: "))
(setq YBAYZ (getdist "\nEnter vertical distance between axes: "))
(setq DIR (* STTXT 3))
(setq RAD STTXT)
(setq XLEN (+ 192 (* YBAYZ YBAYN)))
(setq YLEN (+ 192 (* XBAYZ XBAYN)))
(setq XNUM 1)
(setq XP2 (list (car P1) (+ 96 (cadr P1))))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XINSTR XBAYZ)
(while (/= XBAYN 0.0)
(command "dim" "hor" (list (car XP2) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD)) ""
)
(command)
(setq XP2 (list (+ (car XP2) XINSTR) (cadr XP2)))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(setq XNUM (+ XNUM 1))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XBAYN (- XBAYN 1))
)
(command)
(setq YNUM 65)
(setq LETR (chr YNUM))
(setq YP2 (list (- (car P1) 96) (cadr P1)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YINSTR YBAYZ)
(while (/= YBAYN 0.0)
(command "dim" "vert" (list (+ (car YP2) RAD) (cadr YP2))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR)) ""
)
(command)
(setq YP2 (list (car YP2) (- (cadr YP2) YINSTR)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(setq YNUM (+ YNUM 1))
(if (= YNUM 73) (setq YNUM 74))
(setq LETR (chr YNUM))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YBAYN (- YBAYN 1))
)
(command)
(princ)
(setvar "ORTHOMODE" OM)
(setvar "CMDECHO" CE)
)
(c:cg)

Advertisements