- 积分
- 1711
- 明经币
- 个
- 注册时间
- 2013-3-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
功能:展控制点分布图
主要问题:
块不能生成,如果使用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)
)
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|