明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1856|回复: 7

Cass横断面转纬地格式?

[复制链接]
发表于 2019-6-13 12:47 | 显示全部楼层 |阅读模式
本帖最后由 树櫴希德 于 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




  1. ;;测试 (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)


  2. ;(setq pzx '( "520,12" "1314,14" "147,585" "0,14" "-148,52" "-525,474" "-41,565"))

  3. (defun fast1 (l a / b c)
  4.   (while l
  5.     (if        (= a (substr (car l) 1 1))
  6.       (progn (if b
  7.                (setq c (cons (reverse b) c)
  8.                      b nil
  9.                )
  10.              )
  11.              (setq b (cons (car l) b)
  12.                    l (cdr l)
  13.              )
  14.              (while (and l (/= a (substr (car l) 1 1)))
  15.                (setq b (cons (car l) b)
  16.                      l (cdr l)
  17.                )
  18.              )
  19.              (setq c (cons (reverse b) c)
  20.                    b nil
  21.              )
  22.       )
  23.       (progn (setq b (cons (car l) b)
  24.                    l (cdr l)
  25.              )
  26.       )
  27.     )
  28.   )
  29.   (if b
  30.     (setq c (cons (reverse b) c)
  31.           b nil
  32.     )
  33.   )
  34.   (reverse c)
  35. );;测试 (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))


  36. (gc)
  37. (vl-load-com)
  38. ;;;;;;;;;;;;;;;;;;;
  39. (defun str->pt (str)
  40.     (XD::Pnt:SetZ
  41.       (mapcar 'distof (cdr (String:Split str ",")))
  42.       0.
  43.     )
  44.   )

  45. ;;;;;;;;;;;
  46. (defun String:Split (str delimiter / post strlst stl)
  47.     (if        str
  48.       (progn
  49.         (setq stl (strlen delimiter))
  50.         (while (vl-string-search delimiter str)
  51.           (setq        post   (vl-string-search delimiter str)
  52.                 strlst (cons (substr str 1 post) strlst)
  53.                 str    (substr str (+ 1 post stl))
  54.           )
  55.         )
  56.         (reverse (vl-remove "" (cons str strlst)))
  57.       )
  58.     )
  59.   )
  60. ;;;;;;;;;;;;;;
  61. (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)
  62. (setq fn (getfiled "Select Log file请选取南方CASS横断面数据文件:" "" "hdm" 8))

  63. (setq f (open (findfile fn) "r"))

  64. (while (setq l (read-line f))
  65.     (setq ll (cons l  ll ) )
  66.   )
  67. (close f)
  68. (setq pzx (fast1(reverse ll) "b") )
  69. (setq ff(open(getfiled "建立纬地数据?数据文件" "C:\\" "txt" 36)"a"))

  70. (foreach x pzx
  71. (setq zh (car(cdr(String:Split (car x) "," ))))
  72. (setq xb (fast1 (cdr x) "0"))
  73. (setq dmgc (distof(car(cdr(String:Split(car(cadr xb)) ",")))1))
  74.   (SETQ TAITOU (strcat zh ","(car(cdr(String:Split(car(cadr xb)) ","))) ) )
  75. (write-line TAITOU ff)
  76.   
  77. (foreach y (car xb)
  78. (setq juli (car(String:Split y ",")))
  79. (setq gcc(distof (cadr (String:Split y ",") )1))
  80.   (setq lll (strcat juli ","  (vl-prin1-to-string  (- gcc dmgc)) " " ) )
  81.   (setq llll (cons lll llll))
  82.     )
  83.   (write-line (apply 'strcat (reverse llll)) ff)
  84.   (foreach z (cadr xb)
  85. (setq julia (car(String:Split z ",")))
  86. (setq gcca(distof (cadr (String:Split z ",") )1))
  87.   (setq llla (strcat julia ","  (vl-prin1-to-string  (- gcca dmgc)) " " ))
  88.     (setq lllla (cons llla lllla))
  89.    )
  90.   (write-line (apply 'strcat (reverse lllla)) ff)
  91.   

  92.   )
  93. (close ff)
  94. ;(fast1(cdar(fast1(reverse ll) "b") ) "0")
  95. ;(fast1(car(fast1(reverse ll) "b") ) "0")
  96. ;(("begin,1020" "-45,12" "-40,15" "-35,22" "-30,15" "-25,3" "-15,10" "-8,6")
  97. ;("0,9" "3,15" "16,22" "26,16" "33,14" "45,22"))



  98. ;命令: (fast1(cdar(fast1(reverse ll) "b") ) "0")
  99. ;(("-45,12" "-40,15" "-35,22" "-30,15" "-25,3" "-15,10" "-8,6") ("0,9" "3,15"
  100. ;"16,22" "26,16" "33,14" "45,22"))

  101. )

 楼主| 发表于 2019-6-13 12:52 | 显示全部楼层
CASSTOWD 请问这是纬地格式吗?

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2019-6-30 23:07 | 显示全部楼层
这个不是纬地格式的数据
 楼主| 发表于 2019-7-10 18:49 | 显示全部楼层
本帖最后由 树櫴希德 于 2019-7-11 18:56 编辑

  1. (defun LC:WH-vxs (e / zbb)

  2. (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget e))) ))
  3. zbb
  4.   )


  5. ;;;;;;;;;;;;;
  6. (defun cx-ss2en
  7.   (ss / enlst)
  8.   (cond
  9.     ((= (type ss) 'PICKSET)
  10.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  11.     )
  12.     ((= (type ss) 'LIST)
  13.       (setq enlst (ssadd))
  14.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  15.     )
  16.     ((='ename(type ss))
  17.       (ssadd ss)
  18.     )
  19.   )
  20. )
  21. ;[功能]生成射线
  22. ;[用法](LC:Entmake-XlineX (getpoint))
  23. (defun LC:Entmake-XlineX (pt)
  24.     (entmakeX (list '(0 . "XLINE")
  25.                     '(100 . "AcDbEntity")
  26.                     '(100 . "AcDbXline")
  27.                     (cons 10 pt)
  28.                     (cons 11 '(1 0 0))
  29.               )
  30.     )
  31.   )
  32. ;;[功能]点表生成多段线
  33. (defun LC:Make-LWPOLYLINE1 (lst / PT pts)
  34.   (entmake (append (list '(0 . "LWPOLYLINE")
  35.     '(100 . "AcDbEntity")
  36.     '(100 . "AcDbPolyline")
  37.     '(62 . 1)
  38.     (cons 90 (length lst))
  39.      )
  40.      (mapcar '(lambda (pt) (cons 10 pt)) lst)
  41.     )
  42.   )
  43. )

  44. ;;[功能]pline,lwpline点坐标表  By 无痕
  45. ;;[用法](LC:WH-vxs (car (entsel))),返回三维点坐标
  46. (defun aLC:WH-vxs (e / i v lst)
  47.   (setq i -1)
  48.   (while
  49.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
  50.      (setq lst (cons v lst))
  51.   )
  52.   (reverse lst)
  53. )

  54. (defun c:xzlw ( / ssa 210LAST PTS)
  55.   
  56. (setq ssa (ssget '( (0 . "lwpolyline,spline")   ) ) ) ;(8 . "0")
  57.   
  58. (foreach e (cx-ss2en ssa)
  59.   (SETQ 210LAST  (last(assoc 210 (entget e)) )  )
  60.    (COND ( (= 210LAST -1)  (setq pts (mapcar '(lambda(x) (trans x '(0 0 -1) 0)) (LC:WH-vxs e)  )   )    )
  61.   ( (= 210LAST 1)  (setq pts  (LC:WH-vxs e)  )    )

  62.      )

  63.   
  64.   (if (> (caar pts)  (car(last pts))  ) (setq pts (reverse pts) )  (setq pts pts)   )
  65. ;(setq e (car(entsel "\n请选择多段线:")))
  66. (LC:Make-LWPOLYLINE1 (list (car pts )  (last pts )   ))

  67. ; (sssetfirst nil (cx-ss2en(list e (entlast))  ) )

  68. (vl-cmdf "_.rotate" (cx-ss2en(list e (entlast))  ) "" (car pts )  "r"  (car pts ) (last pts )    (polar (car pts )  0.000  100)

  69.    )

  70. )
  71. (princ)
  72. )
发表于 2019-7-15 18:53 | 显示全部楼层
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
第二个桩号处理后的结果怎么把第一个桩号的结果给带过来了
发表于 2019-12-16 10:30 | 显示全部楼层
纬地格式的数据文件是dmx和hdm分开的
发表于 2020-10-30 14:02 | 显示全部楼层


还是支持原创   支持
发表于 2020-11-7 08:01 来自手机 | 显示全部楼层
支持源代码分享   
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 19:43 , Processed in 0.387813 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表