Cass横断面转纬地格式？
本帖最后由 树櫴希德 于 2019-6-13 12:48 编辑begin,1020
-45,12
-40,15
-35,22
-30,15
-25,3
-15,10
-8,6
0,9
3,15
16,22
26,16
33,14
45,22
begin,1040
-50,23
-45,36
-40,15
-35,20
-30,15
-25,16
-20,18
-17,22
-10,16
0,22
8,6
15,2
19,12
25,14
31,21
40,26
48,33
50,30
;;;;;
1020,9
-45,3.0 -40,6.0 -35,13.0 -30,6.0 -25,-6.0 -15,1.0 -8,-3.0
0,0.0 3,6.0 16,13.0 26,7.0 33,5.0 45,13.0
1040,22
-45,3.0 -40,6.0 -35,13.0 -30,6.0 -25,-6.0 -15,1.0 -8,-3.0 -50,1.0 -45,14.0 -40,-7.0 -35,-2.0 -30,-7.0 -25,-6.0 -20,-4.0 -17,0.0 -10,-6.0
0,0.0 3,6.0 16,13.0 26,7.0 33,5.0 45,13.0 0,0.0 8,-16.0 15,-20.0 19,-10.0 25,-8.0 31,-1.0 40,4.0 48,11.0 50,8.0
;;测试 (f '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2)2) ==>'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2)) (substr (car l) 1 1)
;(setq pzx '( "520,12" "1314,14" "147,585" "0,14" "-148,52" "-525,474" "-41,565"))
(defun fast1 (l a / b c)
(while l
(if (= a (substr (car l) 1 1))
(progn (if b
(setq c (cons (reverse b) c)
b nil
)
)
(setq b (cons (car l) b)
l (cdr l)
)
(while (and l (/= a (substr (car l) 1 1)))
(setq b (cons (car l) b)
l (cdr l)
)
)
(setq c (cons (reverse b) c)
b nil
)
)
(progn (setq b (cons (car l) b)
l (cdr l)
)
)
)
)
(if b
(setq c (cons (reverse b) c)
b nil
)
)
(reverse c)
);;测试 (f '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2)2) ==>'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2))
(gc)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;
(defun str->pt (str)
(XD::Pnt:SetZ
(mapcar 'distof (cdr (String:Split str ",")))
0.
)
)
;;;;;;;;;;;
(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 c:casstoWD( / fn f fnn ff l ll pzx zh xb dmgc taitou x y z juli julia gcc gcca lll llla llll lllla)
(setq fn (getfiled "Select Log file请选取南方CASS横断面数据文件：" "" "hdm" 8))
(setq f (open (findfile fn) "r"))
(while (setq l (read-line f))
(setq ll (cons lll ) )
)
(close f)
(setq pzx (fast1(reverse ll) "b") )
(setq ff(open(getfiled "建立纬地数据？数据文件" "C:\\" "txt" 36)"a"))
(foreach x pzx
(setq zh (car(cdr(String:Split (car x) "," ))))
(setq xb (fast1 (cdr x) "0"))
(setq dmgc (distof(car(cdr(String:Split(car(cadr xb)) ",")))1))
(SETQ TAITOU (strcat zh ","(car(cdr(String:Split(car(cadr xb)) ","))) ) )
(write-line TAITOU ff)
(foreach y (car xb)
(setq juli (car(String:Split y ",")))
(setq gcc(distof (cadr (String:Split y ",") )1))
(setq lll (strcat juli ","(vl-prin1-to-string(- gcc dmgc)) " " ) )
(setq llll (cons lll llll))
)
(write-line (apply 'strcat (reverse llll)) ff)
(foreach z (cadr xb)
(setq julia (car(String:Split z ",")))
(setq gcca(distof (cadr (String:Split z ",") )1))
(setq llla (strcat julia ","(vl-prin1-to-string(- gcca dmgc)) " " ))
(setq lllla (cons llla lllla))
)
(write-line (apply 'strcat (reverse lllla)) ff)
)
(close ff)
;(fast1(cdar(fast1(reverse ll) "b") ) "0")
;(fast1(car(fast1(reverse ll) "b") ) "0")
;(("begin,1020" "-45,12" "-40,15" "-35,22" "-30,15" "-25,3" "-15,10" "-8,6")
;("0,9" "3,15" "16,22" "26,16" "33,14" "45,22"))
;命令: (fast1(cdar(fast1(reverse ll) "b") ) "0")
;(("-45,12" "-40,15" "-35,22" "-30,15" "-25,3" "-15,10" "-8,6") ("0,9" "3,15"
;"16,22" "26,16" "33,14" "45,22"))
)
CASSTOWD 请问这是纬地格式吗？
这个不是纬地格式的数据 本帖最后由 树櫴希德 于 2019-7-11 18:56 编辑
(defun LC:WH-vxs (e / zbb)
(setq zbb(mapcar'(lambda (x) (CDR X) )(vl-remove-if-not '(LAMBDA (X) (=(CAR X)10)) (CDR(entget e))) ))
zbb
)
;;;;;;;;;;;;;
(defun cx-ss2en
(ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
((='ename(type ss))
(ssadd ss)
)
)
)
;[功能]生成射线
;[用法](LC:Entmake-XlineX (getpoint))
(defun LC:Entmake-XlineX (pt)
(entmakeX (list '(0 . "XLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbXline")
(cons 10 pt)
(cons 11 '(1 0 0))
)
)
)
;;[功能]点表生成多段线
(defun LC:Make-LWPOLYLINE1 (lst / PT pts)
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(62 . 1)
(cons 90 (length lst))
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;[功能]pline,lwpline点坐标表By 无痕
;;[用法](LC:WH-vxs (car (entsel))),返回三维点坐标
(defun aLC:WH-vxs (e / i v lst)
(setq i -1)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)
(defun c:xzlw ( / ssa 210LAST PTS)
(setq ssa (ssget '( (0 . "lwpolyline,spline") ) ) ) ;(8 . "0")
(foreach e (cx-ss2en ssa)
(SETQ 210LAST(last(assoc 210 (entget e)) ))
(COND ( (= 210LAST -1)(setq pts (mapcar '(lambda(x) (trans x '(0 0 -1) 0)) (LC:WH-vxs e)) ) )
( (= 210LAST 1)(setq pts(LC:WH-vxs e)) )
)
(if (> (caar pts)(car(last pts))) (setq pts (reverse pts) )(setq pts pts) )
;(setq e (car(entsel "\n请选择多段线：")))
(LC:Make-LWPOLYLINE1 (list (car pts )(last pts ) ))
; (sssetfirst nil (cx-ss2en(list e (entlast))) )
(vl-cmdf "_.rotate" (cx-ss2en(list e (entlast))) "" (car pts )"r"(car pts ) (last pts ) (polar (car pts )0.000100)
)
)
(princ)
)
1040,22
-45,3.0 -40,6.0 -35,13.0 -30,6.0 -25,-6.0 -15,1.0 -8,-3.0 -50,1.0 -45,14.0 -40,-7.0 -35,-2.0 -30,-7.0 -25,-6.0 -20,-4.0 -17,0.0 -10,-6.0
0,0.0 3,6.0 16,13.0 26,7.0 33,5.0 45,13.0 0,0.0 8,-16.0 15,-20.0 19,-10.0 25,-8.0 31,-1.0 40,4.0 48,11.0 50,8.0
第二个桩号处理后的结果怎么把第一个桩号的结果给带过来了 纬地格式的数据文件是dmx和hdm分开的
还是支持原创 支持 支持源代码分享
页:
[1]