求助在CASS中利用LOG文件展高程点
求助利用LOG文件展高程点,LOG文件格式如下:编号: 5252111,61055.433,11666.052,7.984
2,61055.612,11665.999,7.963
3,61057.374,11667.853,8.104
挖方: 0.00 填方: 0.15
编号: 2
1,61055.053,11666.662,8.101
2,61055.433,11666.052,7.984
3,61057.374,11667.853,8.104
挖方: 0.00 填方: 0.67
编号: 3
1,61055.489,11665.870,7.953
2,61055.433,11666.052,7.984
3,61055.612,11665.999,7.963
挖方: 0.00 填方: 0.02
编号: 4
1,61051.316,11661.480,7.620
2,61052.069,11665.129,8.096
3,61055.053,11666.662,8.101
挖方: 0.00 填方: 5.47
编号: 5
1,61051.316,11661.480,7.620
2,61055.053,11666.662,8.101
3,61055.433,11666.052,7.984
挖方: 0.00 填方: 2.38
编号: 6
1,61051.316,11661.480,7.620
2,61055.433,11666.052,7.984
3,61054.542,11664.874,7.878
挖方: 0.00 填方: 0.44
只利用其中三维坐标展点，其他不用管。
(defun gxl-cs:gcd (inspt height scale xsws / pt blkdef obj)(setvar "CMDECHO" 0)
(command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 3))
(setq height "")
)
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 2)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc);设置比例尺
;(setq zg (* 0.002 blc));字高
(setq scale (* 0.001 blc));缩放比例
(defun _List:FromFile (fn / f l ll)
(if (setq f (open (findfile fn) "r"))
(progn
(while (setq l (read-line f))
(setq ll (cons l ll))
)
(close f)
)
)
ll
)
(if (setq fl (getfiled "Select Log file" "" "log" 8))
(progn
(setq lst (_List:FromFile fl))
(while lst
(setq nl(cons (list (car lst)
(cadr lst)
(caddr lst)
(nth 3 lst)
(nth 4 lst)
)
nl
)
lst (cddr (cddddr lst))
)
)
)
)
搞不出来了大家帮帮忙啊
这是TXT文件 因为明经不能上传LOG文件
有大量重复点。。 004 发表于 2015-6-15 13:35 static/image/common/back.gif
有大量重复点。。
SY所以我用OVERKILL清除重复点 或者删除重复高程 004 发表于 2015-6-15 13:35 static/image/common/back.gif
有大量重复点。。
(alert "\n三角网破网标高注记SJWBGZJ")
(defun c:sjwbgzj ()
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(setvar "CMDECHO" 0)
(command "layer" "m" "bgGCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 3));3为高程注记位数
(setq height "")
)
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(list -3 '("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 62 3)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun String:Split (str delimiter / post strlst stl)
(if str
(progn
(setq stl (strlen delimiter))
(while (vl-string-search delimiter str)
(setq post (vl-string-search delimiter str)
strlst (cons (substr str 1 post) strlst)
str (substr str (+ 1 post stl))
)
)
(reverse (vl-remove "" (cons str strlst)))
)
)
)
;;;;;;;;
(defun XD::Pnt:SetZ (p z)
(list (car p) (cadr p) (caddr p));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
(defun str->pt (str)
(XD::Pnt:SetZ
(mapcar 'distof (cdr (String:Split str ",")))
0.
)
)
(defun _List:FromFile (fn / f l ll)
(if (setq f (open (findfile fn) "r"))
(progn
(while (setq l (read-line f))
(setq ll (cons l ll))
)
(close f)
)
)
ll
)
(if (setq fl (getfiled "Select Log file" "" "log" 8))
(progn
(setq lst (_List:FromFile fl))
(while lst
(setq nl(cons (list (car lst)
(cadr lst)
(caddr lst)
(nth 3 lst)
(nth 4 lst)
)
nl
)
lst (cddr (cddddr lst))
)
)
(mapcar '(lambda (x / pu n)
(setq pu (list (str->pt (cadr x))
(str->pt (caddr x))
(str->pt (cadddr x)))
)
(foreach n pu
(gxl-cs:gcd n (caddr n) scale) )
)
nl
)
)
)
)
页:
[1]