展控制点分布图，请高人完善，
功能：展控制点分布图主要问题：
块不能生成，如果使用CASS的"绘图处理----展控制点"功能之后，
再使用这个插件，就能生成图块,是不是要先定义一下图块？如何定义？
帮我指点一下，先谢谢了，新手，第一次发，不要笑话。下面是演示
数据，DAT格式：
1,C07-A12,500241.793,3000010.919,78.567
2,C09-A11,500020.099,3000014.240,88.777
3,C08-A10,500339.770,3000122.169,99.333
4,C00-A9,500130.531,3000122.169,73.567
6,C01-a7,500235.150,3000242.552,47.999
7,C10-A6,500021.759,3000241.722,66.888
8,C02-A5,500340.600,3000365.426,37.092
9,C06-A4,500130.531,3000359.614,58.345
10,C03-A3,500426.122,3000476.676,67.123
11,C05-A2,500234.320,3000475.846,23.887
12,C04-A1,500025.224,3000480.841,23.444
;展控制点名(用于控制点分布图)。
;数据文件格式为：DAT格式
;序号1,bm-dm1,Y1, X1, H1
;序号2,bm-dm2,Y2, X2, H2
;序号3,bm-dm3,Y3, X3, H3
;......
;序号n,bm-dmn,Yn, Xn, Hnn
(defun c:kzd()
(setq
osmode_old (getvar "osmode")
cmdecho_old (getvar "cmdecho")
clayer_old (getvar "clayer")
)
(setvar "cmdecho" 0)
(setq drawm0 (getvar "userr1"))
(if (= drawm0 0)
(setq drawm0 (getreal "\n 绘图比例尺1: <500>："))
)
(if (= drawm0 nil) (setq drawm0 500.0))
(setvar "userr1" drawm0)
(setq drawscl (/ drawm0 1000))
(setvar "osmode" 0)
(setq fhb nil)
(setq ff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r"))
(while (setq jj (read-Line ff))
(setq L0 (vl-string-translate "," " " jj)) ;把逗号替换为空格
(setq L1 (vl-string-translate "-" " " L0)) ;把-替换为空格
(setq L (read (strcat "(" L1 ")"))) ;转换为表
(setq bm (vl-princ-to-string (cadr L))) ;取得编码
(cond
((= bm "C00") (setq tukm "gc261"))
((= bm "C01") (setq tukm "gc259"))
((= bm "C02") (setq tukm "gc257"))
((= bm "C03") (setq tukm "gc114"))
((= bm "C04") (setq tukm "gc113"))
((= bm "C05") (setq tukm "gc014"))
((= bm "C06") (setq tukm "gc015"))
((= bm "C07") (setq tukm "gc112"))
((= bm "C08") (setq tukm "gc118"))
((= bm "C09") (setq tukm "gc168"))
((= bm "C10") (setq tukm "gc258"))
)
(setq zb (list (list (nth 3 L) (nth 4 L)) tukm (vl-princ-to-string (caddr L)))) ;生成新表((y x) 编码 点名)
(setq fhb (append fhb (list zb))) ;合并在一个文件里面
)
(close ff)
(foreach zb fhb ;取表中的元素
(setq zfc (last zb);点名
pt (car zb) ;坐标
)
(entmake
(list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 8 "kzd") '(100 . "AcDbText")
(cons 40(* 3.00 drawscl)) '(50 . 0.0) '(7 . "正等线体")
(cons 10 (mapcar '+ pt (list (* 2.50 drawscl) (* -1.25 drawscl)))) (cons 1 zfc)
)
)
(entmake
(list '(0 . "INSERT") '(100 . "AcDbEntity") (cons 8 "kzd") '(100 . "AcDbBlockReference")
(cons 2 (cadr zb)) (cons 10 pt) (cons 41 (* 1 drawscl)) (cons 42 (* 1 drawscl))
)
)
)
(command"zoom" "e")
(setvar "osmode" osmode_old)
(setvar "cmdecho" cmdecho_old)
(setvar "clayer" clayer_old)
(prin1)
)
本帖最后由 llsheng_73 于 2013-10-26 22:04 编辑
它不能直接出来是因为你所用的图块没有事先定义，一般情况下要使用图块都需要对图块进行预定义才能使用，而你用一下展控制点的功能后，CASS会把图块进行一次定义，所以后边你就能正常使用了
但是，这么多块（光是控制点得十好几个，要是后边你再弄点别的，会需要的更多）如果不直接用CASS里边的都去自己定义的话很累的，可以在程序开始的用一句(COMMAND "casshuanjing")引号里边具体是怎么写的记不清了，你可以手动点一下那个加入CASS环境，看下它的命令具体怎么写的；还有一个办法是，把CASS目录里边那个叫CASS90.DWG或者别的什么类似名字的一个空图用insert的办法把它插入到当前图形，也能完成所有CASS图块的预定义。
这是很合算的，因为一句话就把几百个图块全部定义完了
当然，如果你最终想要完全脱离CASS来使用你的展点程序，那前边偷懒的办法是行不通了，那么你必须对你所用要的块进行定义，最简单的办法就是把cass的BLOCKS里边你所用到的图块文件COPY出来，一个个的INSERT后删除它们。
你的程序在文件最后没有空行，每行都完全一样的情况下是没有问题的，如果最后有空行，程序会出错，这种情况不影响，因为反正点已经展完了，但在中间某行与你的数据格式不一样时会因此出错而中断，这种情况下你当然可以骂给你数据的人，但还是会头痛，所以建议你对每行数据进行检查再进行展点，如果有数据异常（与规定格式不一致），可以考虑在txt窗口输出这一行内容，以方便查改，程序这时候可以中断也可以继续，具体怎么处理看你怎么想了
还有
(setq L0 (vl-string-translate "," " " jj)) ;把逗号替换为空格
(setq L1 (vl-string-translate "-" " " L0)) ;把-替换为空格
这几句可以小弄一下
(setq jj (read-Line ff))
(setq L1 (vl-string-translate ",-" "" jj));;一句vl-string-translate 实际上是可以完成多个替换的，不过是要求前后一一对应，不能因为反正最终都是对应同一个而误以为后边可以把相同的省略掉
程序中几处(CONS 10 PT)纠正了我一直以来的错误理解，我以前一直是(append(list 10) pt)这样来处理的，比如(entmake (list(cons 0 "POINT")(append(list 10)(getpoint))))谢谢楼主了 其实有时候是自己把问题弄复杂了,要实现你展控制点的功能,何需编程.
不信楼主你试试:
绘图处理/简码识别 谢谢“llsheng_73 ”的指定，困扰我几天的问题终于解决了，用简码识别出来的是完整的展控制点的格式，点名下面有横线和高程，不是“控制点分布图”的格式。再次感谢
页:
[1]