[编程交流] 测量网格Lisp

(defun c:addgrid()
(SETVAR "SNAPANG" 0)
(SETQ space (GETreal "\n Input Grid Interval :- "))
(setq pt1 (getpoint "\n Pick Bottom Left Corner for Grid :- "))
(setq pt2 (getcorner pt1 "\n Pick Top Right Corner for Grid :- "))
(setq scale (getreal "\n Scale for Grid Information :- "))
(SETVAR "CMDECHO" 0)
(SETVAR "ANGBASE" 0)
(SETVAR "ANGDIR" 0)
(setq csize (* 10.0 (/ scale 1000.0)))
(setq X1 (CAR PT1))
(SETQ Y1 (CADR PT1))
(SETQ X2 (CAR PT2))
(SETQ Y2 (CADR PT2))
(SETQ X1A (/ X1 SPACE))
(SETQ X1b (FIX X1A))
(SETQ X1c (- X1A X1b))
(SETQ X1c (* X1c SPACE));remainder
(SETQ y1A (/ y1 SPACE))
(SETQ y1b (FIX y1A))
(SETQ y1c (- y1A y1b))
(SETQ y1c (* y1c SPACE));remainder
(SETQ y2A (/ y2 SPACE))
(SETQ y2b (FIX y2A))
(SETQ y2c (- y2A y2b))
(SETQ y2c (* y2c SPACE));remainder
(SETQ X2A (/ X2 SPACE))
(SETQ X2b (FIX X2A))
(SETQ X2c (- X2A X2b))
(SETQ X2c (* X2c SPACE));remainder
(setq x1b (* (+ x1b 1) space))
(setq y1b (* (+ y1b 1) space))
(setq x2b (* x2b space))
(setq y2b (* y2b space))
(setq xarr (- x2b x1b))
(setq xarr (/ xarr space))
(setq yarr (- y2b y1b))
(setq yarr (/ yarr space))
(setq orig (list x1b y1b))
(command "line" (list x1b (- y1b csize)) (list x1b (+ y1b csize)) "")
(setq l1 (entlast))
(command "line" (list (- x1b csize) y1b) (list (+ x1b csize) y1b) "")
(setq l2 (entnext l1))
(setq yarr (fix yarr)) (setq xarr (fix xarr))
(command "array" l1 l2 "" "r" (+ 1 yarr) (+ 1 xarr) space space)
(setq east x1b)
(setq inner (/ 1.0 (/ 1000.0 scale)))
(setq tsize (/ 1.5 (/ 1000.0 scale)))
(repeat (+ xarr 1)
(setq texor (list (+ east inner) (- y2 inner)))
(setq val (rtos east 2 3))
(SETQ VAL (STRCAT VAL "E"))
(command "text" texor tsize "270" val)
(setq east (+ east space))
)
(setq east x1b)
(repeat (+ xarr 1)
(setq texor (list (+ east inner) (+ y1 inner)))
(setq val (rtos east 2 3))
(setq val (strcat val "E"))
(command "text" "r" texor tsize "270" val)
(setq east (+ east space))
)
(setq north y1b)
(repeat (+ 1 yarr)
(setq texor (list (+ x1 inner) (+ north inner)))
(setq val (rtos north 2 3))
(SETQ VAL (STRCAT VAL "N"))
(command "text" texor tsize "0" val)
(setq north (+ north space))
)
(setq north y1b)
(repeat (+ 1 yarr)
(setq texor (list (- x2 inner) (+ north inner)))
(setq val (rtos north 2 3))
(SETQ VAL (STRCAT VAL "N"))
(command "text" "r" texor tsize "0" val)
(setq north (+ north space))
)
(SETVAR "CMDECHO" 1)
)

(setvar "cLAYER" GRID--2)
(setq IP1 (getpoint "\nSTARTING POINT  (TOP LEFT CORNER): "))(terpri)
(setq X(car IP1)) (setq Y(cadr IP1))
(setq EWLIST(list X)) (setq NSLIST(list Y))
(setq #EW(getint"Number of GRIDS across: "))(terpri)
(setq EW1(getint"Dimension for first GRID: "))(terpri)
(setq EWD(+ X EW1)) (setq EWLIST(append EWLIST (list EWD)))
(setq EW2(itoa EW1))
(setq #BAY 2)
(repeat (- #EW 1)
(setq $BAY(itoa #BAY))
(setq FISH(strcat "Dimension for Grid " $BAY ": <RETURN> to repeat previous: "))
(setq EW3(getstring FISH)) (TERPRI)
(if (= (ascii EW3) 0)(setq EW3 EW2))
(setq EW1(atoi EW3)) (setq EW2(itoa EW1))
(setq EWD(+ EWD EW1))
(setq EWLIST(append EWLIST (list EWD)))
(setq #BAY(+ #BAY 1))
)
(setq EWD(+ EWD 2000))
(setq #NS(getint"Number of Grids down: "))(terpri)
(setq NS1(getint"Dimension for first Grid: "))(terpri)
(setq NSD(- Y NS1)) (setq NSLIST(append NSLIST (list NSD)))
(setq NS2(itoa NS1)) (setq #BAY 2)
(repeat (- #NS 1)
(setq $BAY(itoa #BAY))
(setq NS3(getstring"..And next Grid <RETURN> to repeat previous: "))(terpri)
(if (= (ascii NS3) 0)(setq NS3 NS2))
(setq NS1(atoi NS3)) (setq NS2(itoa NS1))
(setq NSD(- NSD NS1))
(setq NSLIST(append NSLIST (list NSD)))
)
(setq NSD(- NSD 2000))
(setq NUM 0)
(repeat (+ #EW 1)
(command "LINE" (list (nth NUM EWLIST)(+ Y 2000))(list (nth NUM EWLIST) NSD))(command)
(setq NUM(+ NUM 1))
(setq #BAY(+ #BAY 1))
)
(setq NUM 0)
(repeat (+ #NS 1)
(command "LINE" (list (- X 2000) (nth NUM NSLIST)) (list EWD (nth NUM NSLIST))) (command)
(setq NUM(+ NUM 1))
)