社区 › AutoLISP/Visual LISP 编程技术 › 绘制公路曲线（改进）

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

绘制公路曲线（改进）

本帖最后由 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 数组转换成 自己需要的形式
(setqlst_str(list "JD="   "state="   "E(Y)="    "N(X)="
          "Lh1="   "R_start=" "R="       "R_end="
          "Lh2="
         )
)
(setqgroup_string
   (mapcar '(lambda (lst)
      (apply 'append lst)
      )
   group_turning_point_original
   )
)
(setqgroup_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))
            (setqlst1 (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))
            (setqlst1 (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)
)
(setqstring (rtos Z_road_start)
string (strcat "Z_start=" string)
)
(setqlst1(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:55

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

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

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

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

再做个中边桩坐标计算

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

这个很有用处

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

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

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

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

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

深入学习！！！！！

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

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

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

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

查看完整版本: 绘制公路曲线（改进）