绘制公路曲线（改进）

ashleytgg · 发表于 2016-5-16 07:13

本帖最后由 ashleytgg 于 2016-5-16 07:09 编辑

;; 程序说明，参照了南方CASS绘制公路中心线的界面，对原来绘制公路中心线进行了修改。希望对广大从事测量的朋友有所帮助，不对的地方，乐意大家提出，以方便修改

(defun change_group_turning_point_original
(group_turning_point_original
Z_road_start
/
group
group_2
group_string
lst_str
lst1
lst2
string
)
;; 把group_turning_point_original 数组转换成自己需要的形式
(setq lst_str (list "JD=" "state=" "E(Y)=" "N(X)="
"Lh1=" "R_start=" "R=" "R_end="
"Lh2="
)
)
(setq group_string
(mapcar '(lambda (lst)
(apply 'append lst)
)
group_turning_point_original
)
)
(setq group_2 ; (setq lst (cadr group_string))
(mapcar '(lambda (lst / state subset)
(setq state (cadr lst))
(setq subset
(append lst lst_str)
)
(if (not state)
(progn
(setq subset
(mapcar '(lambda (i)
(nth i subset)
)
(list 7 0 8 1 9 2 10 3 11 4 13 5 15 6)
)
)
(setq subset
(mapcar '(lambda (i / j lst1 lst2)
(setq j (* i 2))
(setq lst1 (nth j subset)
lst2 (nth (+ j 1) subset)
)
(cond
((= (type lst2) 'real)
(setq lst2 (rtos lst2))
)
((= (type lst2) 'int)
(setq lst2 (itoa lst2))
)
(t
(setq lst2
(vl-princ-to-string
lst2
)
)
)
) ;cond 函数结束
(list lst1 lst2)
)
(list 0 1 2 3 4 5 6)
)
)
)
(progn
(setq subset
(mapcar '(lambda (i)
(nth i subset)
)
(list 9 0 10 1 11 2 12 3 13 7 14 4 15 5 16 6 17 8)
)
)
(setq subset
(mapcar '(lambda (i / j lst1 lst2)
(setq j (* i 2))
(setq lst1 (nth j subset)
lst2 (nth (+ j 1) subset)
)
(cond
((= (type lst2) 'real)
(setq lst2 (rtos lst2))
)
((= (type lst2) 'int)
(setq lst2 (itoa lst2))
)
(t
(setq lst2
(vl-princ-to-string
lst2
)
)
)
) ;cond 函数结束
(list lst1 lst2)
)
(list 0 1 2 3 4 5 6 7 8)
)
)
)
) ; (if (not state) 函数结束
(mapcar '(lambda (lst)
(apply 'strcat lst)
)
subset
)
)
group_string
)
)
;; 把Z_road_start 加入数组 group_2 中的第一行最后一个元素
(if (not Z_road_start)
(setq Z_road_start 0)
)
(setq string (rtos Z_road_start)
string (strcat "Z_start=" string)
)
(setq lst1 (car group_2)
lst2 (append lst1 (list string))
group_2 (append (list lst2) (cdr group_2))
)
(mapcar
'(lambda (lst / str) ; (setq str (car group_2))
(setq str (vl-princ-to-string lst)
str (vl-string-left-trim "(" str)
str (vl-string-right-trim ")" str)
)
)
group_2
)
)
;; (setq tgg (change_group_turning_point_original group_turning_point_original Z_road_start ) )

(defun change_group_turning_point_original 
             (group_turning_point_original 
              Z_road_start 
              / 
              group 
              group_2 
              group_string 
              lst_str 
              lst1 
              lst2 
              string 
             ) 
 
  ;; 把group_turning_point_original 数组转换成 自己需要的形式   
  (setq  lst_str  (list "JD="   "state="   "E(Y)="    "N(X)=" 
          "Lh1="   "R_start=" "R="       "R_end=" 
          "Lh2=" 
         ) 
  ) 
  (setq  group_string 
   (mapcar '(lambda (lst) 
        (apply 'append lst) 
      ) 
     group_turning_point_original 
   ) 
  ) 
  (setq  group_2        ; (setq lst (cadr group_string))   
   (mapcar '(lambda (lst / state subset) 
        (setq state (cadr lst)) 
        (setq subset 
         (append lst lst_str) 
        ) 
        (if  (not state) 
          (progn 
      (setq subset 
             (mapcar '(lambda  (i) 
            (nth i subset) 
          ) 
               (list 7 0 8 1 9 2 10 3 11 4 13 5 15 6) 
             ) 
      ) 
      (setq subset 
             (mapcar '(lambda  (i / j lst1 lst2) 
            (setq j (* i 2)) 
            (setq  lst1 (nth j subset) 
            lst2 (nth (+ j 1) subset) 
            ) 
            (cond 
              ((= (type lst2) 'real) 
               (setq lst2 (rtos lst2)) 
              ) 
              ((= (type lst2) 'int) 
               (setq lst2 (itoa lst2)) 
              ) 
              (t 
               (setq lst2 
                (vl-princ-to-string 
                  lst2 
                ) 
               ) 
              ) 
            ) ;cond 函数结束   
            (list lst1 lst2) 
          ) 
               (list 0 1 2 3 4 5 6) 
             ) 
      ) 
          ) 
          (progn 
      (setq subset 
             (mapcar '(lambda  (i) 
            (nth i subset) 
          ) 
               (list 9 0 10 1 11 2 12 3 13 7 14 4 15 5 16 6 17 8) 
             ) 
      ) 
      (setq subset 
             (mapcar '(lambda  (i / j lst1 lst2) 
            (setq j (* i 2)) 
            (setq  lst1 (nth j subset) 
            lst2 (nth (+ j 1) subset) 
            ) 
            (cond 
              ((= (type lst2) 'real) 
               (setq lst2 (rtos lst2)) 
              ) 
              ((= (type lst2) 'int) 
               (setq lst2 (itoa lst2)) 
              ) 
              (t 
               (setq lst2 
                (vl-princ-to-string 
                  lst2 
                ) 
               ) 
              ) 
            ) ;cond 函数结束   
            (list lst1 lst2) 
          ) 
               (list 0 1 2 3 4 5 6 7 8) 
             ) 
      ) 
          ) 
        )      ; (if  (not state) 函数结束   
        (mapcar '(lambda (lst) 
             (apply 'strcat lst) 
           ) 
          subset 
        ) 
      ) 
     group_string 
   ) 
  ) 
  ;; 把Z_road_start 加入数组 group_2 中的第一行 最后一个元素   
  (if (not Z_road_start) 
    (setq Z_road_start 0) 
  ) 
  (setq  string (rtos Z_road_start) 
  string (strcat "Z_start=" string) 
  ) 
  (setq  lst1  (car group_2) 
  lst2  (append lst1 (list string)) 
  group_2  (append (list lst2) (cdr group_2)) 
  ) 
  (mapcar 
    '(lambda (lst / str)    ; (setq str (car group_2))   
       (setq str (vl-princ-to-string lst) 
       str (vl-string-left-trim "(" str) 
       str (vl-string-right-trim ")" str) 
       ) 
     ) 
    group_2 
  ) 
) 
;; (setq tgg (change_group_turning_point_original group_turning_point_original Z_road_start ) )

quester · 发表于 2016-5-16 07:43

平纵横为什么不合并在一块？超高加宽支持吗？

ashleytgg · 发表于 2016-5-16 09:05

超高，加宽支持，平纵横合在一块，我还没这个水平，也没这个时间。

jjjyxcm · 发表于 2016-5-16 12:24

再做个中边桩坐标计算

LIULISHENG · 发表于 2016-5-16 13:19

这个很有用处

ashleytgg · 发表于 2016-5-17 08:57

回复 jjjyxcm ，可以做中桩坐标计算，具体见gif图

ashleytgg · 发表于 2016-5-19 15:45

演示一下，绘制包含非完整缓和曲线的交点，

，哈哈自娱自乐

zjy2999 · 发表于 2016-5-19 21:00

深入学习！！！！！

ashleytgg · 发表于 2016-5-31 21:27

展示一下利用该小程序，结合南方cass软件绘制公路横断面，
(注意: cad 必须是在安装了南方CASS软件的条件下才能运行图示所示参数)

ashleytgg · 发表于 2016-6-16 22:48

应楼上的提示，把输出方式再加了个表格的样式。但在cad 中创建表格速度非常慢。我也不知道为什么，希望高手指点下。
演示参数中，创建表格需用时3分钟，请耐心等待。

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

[源码] 绘制公路曲线（改进）

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源