Cass横断面转纬地格式？

树櫴希德 · 发表于 2019-6-13 12:47:09

本帖最后由树櫴希德于 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 l ll ) )
)
(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"))
)

;;测试 (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 l  ll ) ) 
  ) 
(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")) 
 
)

树櫴希德 · 发表于 2019-6-13 12:52:37

CASSTOWD 请问这是纬地格式吗？

skg123 · 发表于 2019-6-30 23:07:07

这个不是纬地格式的数据

树櫴希德 · 发表于 2019-7-10 18:49:56

本帖最后由树櫴希德于 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.000 100)
)
)
(princ)
)

(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.000  100) 
 
   ) 
 
) 
(princ) 
)

hao3ren · 发表于 2019-7-15 18:53:02

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
第二个桩号处理后的结果怎么把第一个桩号的结果给带过来了

飞天鱼Tommy · 发表于 2019-12-16 10:30:35

纬地格式的数据文件是dmx和hdm分开的

f4800 · 发表于 2020-10-30 14:02:03

还是支持原创支持

f4800 · 发表于 2020-11-7 08:01:04

支持源代码分享

账号		自动登录	找回密码
密码			注册

Cass横断面转纬地格式？

相关帖子

本帖子中包含更多资源