更新旧LISP代码
在我的办公室，我们使用这个LISP程序来导入我们的调查数据。这是为了在LDD中工作。我们似乎有它运行在Civil 3D后，现在一点调整，但我想我会张贴在这里，看看是否有人有任何想法与它。
它基本上是这样工作的
EG+1=线路起点
EG+2=继续行
EG+3=终点线
我感兴趣的一件事是，如果有人知道如何制作它，那么我们可以制作非连续线。基本上我们可以做一个横截面。你会得到这样的结果：
ER+1
CL+1
ER+1
然后是下一节
ER+2
CL+2
ER+2
一直到最后。这样可以避免在路上来回走动多次。现在我已经在一个程序中看到了这一点，其中每行只使用一个代码。这个看起来像这样
ER1-->ER1
CL1-->CL1
ER2-->ER2
因此，它连接使用相同描述符的任何点。这将是很好的，但该计划的成本为1000美元，我们将不得不完全转移到我们的系统。
如果有一种更简单的方法，那就太好了，因为1000美元+多少小时的安装成本并不太吸引人。
无论如何，如果你能想出任何可以帮助我们完成这个项目的想法，那就太好了。
代码如下：
;2002/05/21 - SURVEY.lsp
;this routine reads an ascii file with 5 elements in the order
;of - stn-pt (integer or real), y , x , z , note (string)
;and elevation from z value
;to run this routine you must have a block named in the variable PTDWG with 3
;attributes
(setq REVVER "2")
;rev 2003/03/19 - fix block elev to zero - fix OSNAP problem
;rev 2002/10/04 - neg elevs, check for / or space after 1 letter FC
(setvar "cmdecho" 0)
(setq SNAPSET (menucmd "M=$(getvar,OSMODE)"))
;(print SNAPSET)
(print (strcat "SURVEY ROUTINE LOADED - rev" REVVER))
(defun C:SURVEY ( / F1)
(command "OSMODE" 0)
; (command "OSMODE" 16384)
(setq PTDWG "x-el")
(setq BLKDIR "j:/lib/lisp/blocks.txt")
; (setq BLKDIR "c:/baw/blocks.txt")
(print BLKDIR)
(setqFDIR(getstring "\nENTER PATH (ie C:\\BAW ).."))
(print (vl-directory-files FDIR "*.asc"))
(setqFFILE (getstring "\nENTER FILE NAME (no extension) .."))
(setqFNAME (strcat FDIR "/" FFILE ".asc"))
(setqBLKSCALE (/ (getreal "\ENTER PLOT SCALE (1:500 = 500)") 1000))
(command "Layer" "M" FFILE "")
(setqF1 (open FNAME "r"))
(while
(setq PDATA (read-line F1))
; (print pdata)
;(getstring "ReadLine")
(DO-IT)
);end of while
(close F1)
(command "ZOOM" "e")
(print "OK")
(command "OSMODE" SNAPSET)
);end of points
(defun do-it ( / pnt n m L P x y)
;(print "DO-IT MODULE")(print PDATA)
(setq
COUNTER99 1
n 1
m 1
pnt nil
pnt2 nil
DESC nil
L (strlen pdata)
);end of setq
(while (< n (+ L 2))
(setq x (substr pdata n 1))
; (if (or (or (= x ",") (= x "")) (or (= x "/") (= x " ")))
(if (or (= x ",") (= x ""))
(progn
(setq PNT
(append PNT
(list (atof (substr PDATA M (- N M))))
);end of append
);end of setq
(setq PNT2
(append PNT2
(list (substr PDATA M (- N M)))
);end of append
);end of setq
(setq ATT (vl-string-right-trim " " (last PNT2)))
(setq DESC (vl-string-right-trim "+0" ATT))
(print DESC)
(setq DESC (vl-string-right-trim "+1" DESC))
(print DESC)
(setq DESC (vl-string-right-trim "+2" DESC))
(print DESC)
(setq DESC (vl-string-right-trim "+3" DESC))
(print DESC)
; (setq DESC (vl-string-right-trim "+0" ATT))
; (setq DESC (vl-string-right-trim "+1" DESC))
; (setq DESC (vl-string-right-trim "+2" DESC))
; (setq DESC (vl-string-right-trim "+3" DESC))
(print DESC)
(if (= (substr ATT 1 1) "X")
(setq X 1)
(setq X 0)
); end of if
(if (> (vl-string-search "NO Z" ATT) 0)
(setq NOZ 1)
(setq NOZ 0)
); end of if
(setq PNTR (cdr PNT))
(setq TEMP (reverse PNTR))
(setq TEMP (cdr TEMP))
(setq PT (cdr TEMP))
(if (= NOZ 1)
(setq ELEV -99)
(setq ELEV (car TEMP))
); end of if
(setq IP
(list (cadr temp) (caddr temp) ELEV))
(setq IPXY (list (cadr TEMP) (caddr TEMP)))
(setq m (+ n 1))
(setq n (+ n 1))
);end of progn
(setq n (+ n 1))
);end of if
);end of while
(setq el (rtos ELEV 2 2))
(command "Layer" "M" FFILE "")
(if (/= X 1)
(command "insert" PTDWG ip BLKSCALE BLKSCALE 0 (fix (car pnt)) DESC el)
);end of if
; (command "insert" PTDWG ip 1 1 30 (fix (car pnt)) DESC el)
(print (fix (car pnt)))
(setq BNAME (vl-string-right-trim "+" (substr ATT 1 2)))
(setq BNAME (vl-string-right-trim "-" BNAME))
(setq BNAME (vl-string-right-trim "/" BNAME))
(setq BNAME (vl-string-right-trim " " BNAME))
(setq ATTLEN (strlen ATT))
(setq PENCODE (substr ATT (- ATTLEN 1) 2))
(if (= PENCODE "+1")
(progn
(setq PLVERTS2d (list IPXY))
(setq PLVERTS (list IP))
(setq NUMVERTS 1)
)
); end if
(if (= PENCODE "+2")
(progn
(setq PLVERTS2d (append PLVERTS2d (list IPXY)))
(setq PLVERTS (append PLVERTS (list IP)))
(setq NUMVERTS (+ NUMVERTS 1))
)
); end if
(if (= PENCODE "+3")
(progn
(setq PLVERTS2d (append PLVERTS2d (list IPXY)))
(setq PLVERTS (append PLVERTS (list IP)))
(setq NUMVERTS 0)
(command "LAYER" "M" BLKLAYER "")
(command "PLINE" (foreach XXX PLVERTS2d (command XXX)))
(command "LAYER" "M" (strcat "TOPO3d-" BNAME) "")
(command "3dpoly" (foreach XXXX PLVERTS (command XXXX)))
(command "LAYER" "M" FFILE "")
)
(if (= (substr ATT (- ATTLEN 1) 2) "+0")
(print "no lines"))
); end if
;loop to find block name
(setq BLOCKS (open BLKDIR "r"))
; (print COUNTER99)
(while (< COUNTER99 10)
(setq BDATA (read-line BLOCKS))
(while (/= BNAME (vl-string-right-trim " " (substr BDATA 1 2)))
(setq BDATA (read-line BLOCKS))
) ; end of while
(READBLOCK)
;(if (= BNAME (substr BDATA 1 2))
; (READBLOCK)
; (setq BDATA (read-line BLOCKS))
;
; end of if
; (print BDATA)
(setq COUNTER99 99)
; (getstring "STOP")
); end of while
(setq COUNTER99 1)
(close BLOCKS)
; (PRINT "HOWDY")
);end of do-it
(defun READBLOCK ( / COUNTER NUMBLOCKS FC)
; (getstring "READBLOCK MODULE Counter setup")
(setq
COUNTER 1
NUMBLOCKS 143
FC "AA"
);end of setq
(while (< COUNTER (+ NUMBLOCKS 1))
(setq FC (vl-string-right-trim " " (substr BDATA 1 2)))
(if (= FC BNAME)
(progb)
(setq COUNTER (+ COUNTER 1))
);end of if
);end of while
); end of READBLOCK
(defun PROGB ()
(setq BLKNAME (vl-string-right-trim " " (substr BDATA 9 16)))
; (print BLKNAME)
(setq BLKLAYER (vl-string-right-trim " " (substr BDATA 25 15)))
; (print BLKLAYER)
(command "LAYER" "M" BLKLAYER "")
(setq BATT (substr BDATA 40 1))
(if (= (vl-string-right-trim " " (substr BDATA 9 16)) "MISCSYMB")
(setq BATT "4")); end IF
(if (= BATT "3")
(command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 "" "" ""))
; (command "insert" BLKNAME ip 1 1 0 "" "" ""))
(if (= BATT "2")
(command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 "" ""))
; (command "insert" BLKNAME ip 1 1 0 "" ""))
(if (= BATT "1")
(command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 ""))
; (command "insert" BLKNAME ip 1 1 0 ""))
(if (= BATT "0")
(command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 )
; (command "insert" BLKNAME ip 1 1 0 )
)
(setq COUNTER (+ NUMBLOCKS 1))
);end of progb
也许有些事情需要调查
考虑cond而不是你的4 if语句
在目录中键入时使用GetField而不是getstring
entmake而不是命令“_u.insert”
我会在Lisp程序开始时做一些事情，比如。
(foreach x '("blockname1" "blockname2" "blockname3" "blockname4")
(if (not (tblsearch "block" x))
(progn
(setvar 'cmdecho 0)
(command "_.insert" x nil)
(setvar 'cmdecho 1)
)
)
)
作为一名前民用软件经销商，我们曾数次查看过一个stringing程序。1000美元可能花得很好，我们使用的软件是“Stringer”www.civilsurveysolutions。通用域名格式。au做的不仅仅是将点串起来作为CIV3d的前端。你到底在哪里
无论如何，有一种方法可以串线，你需要一个pxyzd点xyz描述符txt文件，你在描述符上对文件进行排序，但在pt编号上按调查顺序进行二次排序，然后你阅读每一行，检查描述符和外部列表，如果一行连接在一起，直到描述符更改，然后重新开始，因此在一段中，这是一个字符串程序。
此外，横截面测量是一种可行的方法，它提供了最佳模型和特征线，新的测量仪器内置了此功能，因此可以记住您的代码。
现在，对于smarts，描述符可以有01f first fence pt、01f*02f next fence point之类的内容，但从fence 2开始，下一个点01f fence 1继续02f自动连接到最后三个点中间的点01f 01f 01f*c靠近第一个点01f*作为01f 01f*ae绘制一个3点弧 stringer程序就是我正在看的程序。问题是一旦我们有了它，我们必须在它里面完全建立一个新的系统。 当我们在civil 3d 2011中使用它时，看起来它实际上不起作用，线条工作没有完成。我们得到一个零误差或类似的结果。 你下载了演示等尝试你的代码作为eb01不是eb+1+符号可能是问题我们的人使用数字40301边缘的道路字符串1更快地键入，alos如果你有演示联系经销商，他们可能会提供一个演示库供你使用他们应该有eb CL DR TBM PSM等
在此处发布数据示例 这是数据列表。它快了
10065425936.373321696.2883,39.053264，TF+0
10075425935.41321696.2652,39.04745，TF+0
10085425936.865321699.4686,39.34945，TB+1
10095425936.935321701.93,39.112139，TB+2
10105425936.647321703.0839,39.153939，TB+2
10115425936.53321704.3993,39.326792，TB+3
因此，对于TB+1->TB+3，它创建了一条线。如果你在创建这条线时看到一个集水池，你可以去：
TB+1
TB+2
CB+0
TB+2
TB+3
现在我认为你不会再使用+#了，但这让我大致了解了我希望用这个程序做什么。 明确地去掉+并且我把tb1 tb2 tb3读作3个不同的字符串，对吗？如果不是，那么所有TB都应该是TB1，1是字符串，TB2是第二个字符串，TB3是第三个字符串，它们不连接在一起。
在我们的图书馆TB1将按原样工作！位于气缸组1的顶部，并按点数顺序连接所有“TB1”。
此外，与我们的调查人员交谈时，他们只是向每个新字符串添加一个数字，而不是说必须记住单个代码TB1 TB2 TB3的最后一个字符串数字。他们可能有TB11 TB42 Tb45，唯一的限制是当他们达到99时 嘿！
我需要一个LISP从ascii文件中导入多个块。应该如何工作：
*选择文件（或先选择静态地址）
*通过以下方式从文件加载块（块名、X、Y、Z、缩放、旋转、ATTRIBUTE1、ATTRIBUTE2、…、ATTIRBUTEx）
这可能吗？怎样
祝你好运，尤根
页:
[1]