这是我做的另一个图形比例。 这就是我想要的最终结果
文本环绕边缘，绿色突出显示间隔50m，所有绘制到
用户定义的矩形（我将从视口中复制和粘贴）。
干杯 一个实用的观点是，不同的测量不一定具有相同的坐标，因此每个视口都是一次性的。
我会手动完成（使用我的lisp作为基础不到一分钟），而不需要一键完成所有事情。
但是，如果您想花时间编写lisp，那么可以在以后共享它 问题是，在我上一份工作中，我被宠坏了。那里的一个小伙子是Lisp程序的天才！我想他一定是Lisp程序地做梦了！他写了一大堆我认为理所当然的lisp例程。其中一个是他的网格命令，它可以按照您的意愿绘制网格。现在在我的新工作中，我必须从头开始，我开始明白他做了多少！
不过，请放心，如果我成功地启动了我的网格例程，我将与所有人共享它（以及我提出的任何其他内容！）。。。。但必须先让他们工作！ 给你上一份工作的人发电子邮件，让他给你发一些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)
)
加油，加油！我想我会玩一玩，看看是否可以对它进行个性化设置。我甚至可能继续我的工作，只是为了见鬼（如果我能麻烦的话！）
再次感谢所有帮助我的人！ 我终于抽出时间来完成我的网格Lisp程序！我必须承认我真的很自豪。
代码有点凌乱，但命令本身似乎工作正常。（这就够了
我！）
所以，对于你们中感兴趣的人来说，这就是。如有任何反馈，我们将不胜感激。
gridR。lsp 当你下定决心时，看看你能做些什么。祝贺
如果它能按你想要的那样工作，那么它就是完美的。 看了你的代码，做了很多关于比例的事情。我觉得你可以通过计算比例因子来简化比例，而不是为每个比例计算。记住，对于度量，它似乎是1m=1000毫米
算出一个变量，比如setsc为1000/scale，然后你只需要把你的行距表示为setsc*行间距等
这里有一个例子，它使用“repeat”而不是“while”来循环，你可以在repeat中有repeat，这样做更容易3*X 4*Y网格
（重复X（重复Y等）
(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))
)
希望这对其他项目有帮助，作为第一个很好的努力
页:
1
[2]