运用(测量员、工地通路测)格式文件绘制公路曲线

ashleytgg · 发表于 2019-10-15 23:46:16

本帖最后由 ashleytgg 于 2019-10-15 23:44 编辑

酝酿好久，终于把这个程序补充完了，程序主要功能利用——手机工地通路测、测量员程序的格式文件，在CAD中绘制公路曲线。程序支持线路短链处理，短链文件格式为工地通格式的长短链文件。因为时间和精力缘故，程序对于纠错并没有太多处理，如选择不匹配的参数文件，程序会崩溃，此时还需读者自己琢磨。程序的目的是共享，对于解决一般问题还是可以的。对对于5线元的回头曲线，本程序是不支持的
主程序的计算方法，以齐次坐标为主，下面是程序经常用到的计算函数

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv (m v)
(mapcar '(lambda (r)
(apply '+
(mapcar '* r v)
)
)
m
)
)
;| 定义一个刚体运动群，用其次坐标对二维点集合group_pt 进行先旋转，再镜像，最后平移的操作
group_pt 要变换的二维点集合 φ为旋转角度, rotate_pt 为旋转基点
reflelx 为1 时对点集合沿着X轴进行镜像，等于-1 不进行镜像操作
ang 为镜像轴的象限角度，mirror_base 为镜像轴上的一点
U_move 为对点集合进行平移的操作的二维向量
|;
(defun operate_rigid_body (group_pt rotate_pt φ U_move
reflelx mirror_base ang
/ T_rotation group pt
T_综合 T_move T_reflelx
)
;; 定义一个旋转群 ,ang 为旋转的角度，rotate_base 为旋转的基点，
;;当rotate_base 为nil 时，程序便认为是围绕原点( 0 0 )旋转 ,当ang 为nil 时，程序认为旋转角为0度
(defun group_rotate (rotate_base ang / T_r T_sum T_r_pt-1 T_r_pt)
(if ang
(setq T_r
(list
(list (cos ang) (* -1 (sin ang)) 0)
(list (sin ang) (cos ang) 0)
'(0 0 1)
)
)
(setq T_r
(list
(list 1 0 0)
(list 0 1 0)
'(0 0 1)
)
)
)
(if rotate_base
;; 当旋转群的基点在rotate_base
(setq T_r_pt-1
(list
(list 1 0 (* (car rotate_base) -1))
(list 0 1 (* (cadr rotate_base) -1))
'(0 0 1)
)
T_r_pt
(list
(list 1 0 (car rotate_base))
(list 0 1 (cadr rotate_base))
'(0 0 1)
)
T_sum
(mapcar '(lambda (lst)
(setq lst (mxv T_r_pt-1 lst)
lst (mxv T_r lst)
lst (mxv T_r_pt lst)
)
)
(list
'(1 0 0)
'(0 1 0)
'(0 0 1)
)
)
T_sum
(list (mapcar 'car T_sum)
(mapcar 'cadr T_sum)
(mapcar 'caddr T_sum)
)
)
;; 当旋转群的基点为原点时
(setq T_sum T_r)
)
)
;; 定义一个镜像群，ang 为镜像轴的象限度，mirror_base 为镜像轴上的一点
;; 当ang 为 nil 时，程序便认为镜像轴平行于 X 轴
(defun group_mirror
(mirror_base ang /
T_mirror T_sum T_r T_r-1
T_offset T_reflelx
)
(if ang
(setq
;; 对镜像轴以mirror_base ，旋转 (* ang -1), 使得镜像轴平行于X 轴
T_r
(group_rotate mirror_base (* ang -1))
T_r-1
(group_rotate mirror_base ang)
)
(setq
T_r
(list
(list 1 0 0)
(list 0 1 0)
'(0 0 1)
)
T_r-1
(list
(list 1 0 0)
(list 0 1 0)
'(0 0 1)
)
)
)
(setq ;;对镜像轴进行平移，使成于X轴重合
T_offset
(list
(list 1 0 0)
(list 0 1 (* (cadr mirror_base) -1))
'(0 0 1)
)
T_offset-1
(list
(list 1 0 0)
(list 0 1 (cadr mirror_base))
'(0 0 1)
)
T_reflelx
(list
(list 1 0 0)
(list 0 -1 0)
'(0 0 1)
)
)
(setq T_sum
(mapcar '(lambda (lst)
(setq lst (mxv T_r lst)
lst (mxv T_offset lst)
lst (mxv T_reflelx lst)
lst (mxv T_offset-1 lst)
lst (mxv T_r-1 lst)
)
)
(list
'(1 0 0)
'(0 1 0)
'(0 0 1)
)
)
T_sum
(list (mapcar 'car T_sum)
(mapcar 'cadr T_sum)
(mapcar 'caddr T_sum)
)
)
)
;|
(setq T_test (group_mirror
(setq pt (getpoint "请选择镜像轴的基点:\n"))
(getangle "请选择镜像轴的方向:\n" pt)
)
)
(setq group_tang
(mapcar '(lambda (U)
(mxv T_test U)
)
(mapcar '(lambda (U)
(append U (list 1))
)
group_pt
)
)
)
(addpolyline group_tang)
|;
(if (= (length (car group_pt)) 2)
(setq group (mapcar '(lambda (U)
(append U (list 1))
)
group_pt
)
)
(setq group group_pt)
)
;; 创建一个以 rotate_pt 为旋转中心，旋转角为φ 的群 T_rotation
(setq T_rotation (group_rotate rotate_pt φ))
;;T_relfex 为镜像群,对点集合沿着以mirror_base为基点象限角ang的镜像轴进行镜像
(if (= reflelx -1)
(setq T_reflelx (group_mirror mirror_base ang))
(setq T_reflelx
(list
(list 1 0 0)
(list 0 1 0)
'(0 0 1)
)
)
)
(if U_move
(setq T_move
(list
(list 1 0 (car U_move))
(list 0 1 (cadr U_move))
'(0 0 1)
)
)
(setq T_move
(list
(list 1 0 0)
(list 0 1 0)
'(0 0 1)
)
)
)
(setq T_综合
(mapcar '(lambda (lst)
(setq
lst (mxv T_rotation lst)
lst (mxv T_reflelx lst)
lst (mxv T_move lst)
)
)
(list
'(1 0 0)
'(0 1 0)
'(0 0 1)
)
)
)
(setq
;; 对T_综合进行装置
T_综合
(list (mapcar 'car T_综合)
(mapcar 'cadr T_综合)
(mapcar 'caddr T_综合)
)
)
(mapcar '(lambda (U)
(mxv T_综合 U)
)
group
)
)

;; Matrix x Vector  -  Vladimir Nesterovsky 
;; Args: m - nxn matrix, v - vector in R^n 
(defun mxv (m v) 
  (mapcar '(lambda (r) 
       (apply '+ 
        (mapcar '* r v) 
       ) 
     ) 
    m 
  ) 
) 
 
 ;| 定义一个刚体运动群，用其次坐标 对二维点集合group_pt 进行 先旋转， 再镜像，最后 平移的操作   
    group_pt 要变换的二维点集合   φ为旋转角度, rotate_pt 为旋转基点 
   reflelx 为1 时对点集合沿着X轴进行镜像，等于-1 不进行 镜像操作 
    ang 为镜像轴的象限角度，mirror_base 为镜像轴上的一点   
    U_move 为对点集合进行 平移的操作 的二维向量    
    
|; 
(defun operate_rigid_body (group_pt   rotate_pt   φ      U_move 
         reflelx    mirror_base      ang 
         /        T_rotation group      pt 
         T_综合     T_move   T_reflelx 
        ) 
  ;; 定义一个旋转群 ,ang 为旋转的角度，rotate_base 为旋转的基点 ， 
  ;;当rotate_base 为nil 时，程序便认为是围绕 原点( 0 0 )旋转 ,当ang 为nil 时，程序认为旋转角为0度   
  (defun group_rotate (rotate_base ang / T_r T_sum T_r_pt-1 T_r_pt) 
    (if  ang 
      (setq T_r 
       (list 
         (list (cos ang) (* -1 (sin ang)) 0) 
         (list (sin ang) (cos ang) 0) 
         '(0 0 1) 
       ) 
      ) 
      (setq T_r 
       (list 
         (list 1 0 0) 
         (list 0 1 0) 
         '(0 0 1) 
       ) 
      ) 
    ) 
    (if  rotate_base 
      ;; 当旋转群的基点在rotate_base 
      (setq T_r_pt-1 
         (list 
           (list 1 0 (* (car rotate_base) -1)) 
           (list 0 1 (* (cadr rotate_base) -1)) 
           '(0 0 1) 
         ) 
      T_r_pt 
         (list 
           (list 1 0 (car rotate_base)) 
           (list 0 1 (cadr rotate_base)) 
           '(0 0 1) 
         ) 
      T_sum 
         (mapcar '(lambda (lst) 
        (setq lst (mxv T_r_pt-1 lst) 
              lst (mxv T_r lst) 
              lst (mxv T_r_pt lst) 
        ) 
            ) 
           (list 
             '(1 0 0) 
             '(0 1 0) 
             '(0 0 1) 
           ) 
         ) 
      T_sum 
         (list (mapcar 'car T_sum) 
         (mapcar 'cadr T_sum) 
         (mapcar 'caddr T_sum) 
         ) 
 
      ) 
      ;; 当旋转群的基点为原点时 
      (setq T_sum T_r) 
    ) 
  ) 
 
  ;; 定义一个镜像群，ang 为镜像轴的象限度，mirror_base 为镜像轴上的一点 
  ;; 当ang 为 nil 时， 程序便认为 镜像轴 平行于 X 轴 
  (defun group_mirror 
          (mirror_base       ang  / 
           T_mirror    T_sum       T_r  T_r-1 
           T_offset    T_reflelx 
          ) 
    (if  ang 
      (setq 
  ;; 对镜像轴以mirror_base ，旋转 (* ang -1), 使得镜像轴平行于X 轴 
  T_r 
        (group_rotate mirror_base (* ang -1)) 
  T_r-1 
        (group_rotate mirror_base ang) 
      ) 
      (setq 
  T_r 
        (list 
    (list 1 0 0) 
    (list 0 1 0) 
    '(0 0 1) 
        ) 
  T_r-1 
        (list 
    (list 1 0 0) 
    (list 0 1 0) 
    '(0 0 1) 
        ) 
      ) 
    ) 
    (setq ;;对镜像轴 进行 平移，使成于X轴重合 
    T_offset 
         (list 
           (list 1 0 0) 
           (list 0 1 (* (cadr mirror_base) -1)) 
           '(0 0 1) 
         ) 
    T_offset-1 
         (list 
           (list 1 0 0) 
           (list 0 1 (cadr mirror_base)) 
           '(0 0 1) 
         ) 
    T_reflelx 
         (list 
           (list 1 0 0) 
           (list 0 -1 0) 
           '(0 0 1) 
         ) 
    ) 
    (setq T_sum 
    (mapcar  '(lambda (lst) 
         (setq lst (mxv T_r lst) 
         lst (mxv T_offset lst) 
         lst (mxv T_reflelx lst) 
         lst (mxv T_offset-1 lst) 
         lst (mxv T_r-1 lst) 
         ) 
       ) 
      (list 
        '(1 0 0) 
        '(0 1 0) 
        '(0 0 1) 
      ) 
    ) 
    T_sum 
    (list (mapcar 'car T_sum) 
          (mapcar 'cadr T_sum) 
          (mapcar 'caddr T_sum) 
    ) 
    ) 
  ) 
  ;| 
     (setq T_test (group_mirror 
        (setq pt (getpoint "请选择镜像轴的基点:\n")) 
        (getangle "请选择镜像轴的方向:\n" pt) 
      ) 
     ) 
     (setq group_tang 
      (mapcar '(lambda (U) 
           (mxv T_test U) 
         ) 
        (mapcar '(lambda (U) 
             (append U (list 1)) 
           ) 
          group_pt 
        ) 
      ) 
     ) 
     (addpolyline group_tang) 
      |; 
  (if (= (length (car group_pt)) 2) 
    (setq group  (mapcar  '(lambda (U) 
         (append U (list 1)) 
       ) 
      group_pt 
    ) 
    ) 
    (setq group group_pt) 
  ) 
  ;; 创建一个以 rotate_pt 为旋转中心，旋转角为φ 的群 T_rotation 
  (setq T_rotation (group_rotate rotate_pt φ)) 
  ;;T_relfex 为镜像群,对点集合沿着以mirror_base为基点象限角ang的镜像轴 进行镜像   
  (if (= reflelx -1) 
    (setq T_reflelx (group_mirror mirror_base ang)) 
    (setq T_reflelx 
     (list 
       (list 1 0 0) 
       (list 0 1 0) 
       '(0 0 1) 
     ) 
    ) 
  ) 
 
  (if U_move 
    (setq T_move 
     (list 
       (list 1 0 (car U_move)) 
       (list 0 1 (cadr U_move)) 
       '(0 0 1) 
     ) 
    ) 
    (setq T_move 
     (list 
       (list 1 0 0) 
       (list 0 1 0) 
       '(0 0 1) 
     ) 
    ) 
  ) 
 
  (setq  T_综合 
   (mapcar '(lambda (lst) 
        (setq 
          lst (mxv T_rotation lst) 
          lst (mxv T_reflelx lst) 
          lst (mxv T_move lst) 
 
        ) 
      ) 
     (list 
       '(1 0 0) 
       '(0 1 0) 
       '(0 0 1) 
     ) 
   ) 
  ) 
 
  (setq 
    ;; 对T_综合 进行装置 
    T_综合 
     (list (mapcar 'car T_综合) 
     (mapcar 'cadr T_综合) 
     (mapcar 'caddr T_综合) 
     ) 
  ) 
  (mapcar '(lambda (U) 
       (mxv T_综合 U) 
     ) 
    group 
  ) 
 
)

skg123 · 发表于 2019-10-30 01:10:18

楼主对一个程序不断完善，孜孜不倦的精神，值得学习。

JHX948954875 · 发表于 2019-10-30 09:39:09

谢谢楼主分享

ashleytgg · 发表于 2019-11-1 14:26:00

感谢支持，。

LIULISHENG · 发表于 2019-11-4 10:06:33

支持楼主

kkyybb · 发表于 2020-10-31 15:54:36

大神可以提取出单个点中桩坐标计算的吗

f4800 · 发表于 2020-10-31 21:03:07

大神呀，大神万岁

3494355 · 发表于 2021-11-6 00:14:22

很不错，希望能增加一个功能，在图上识取一个坐标，然后就可以反算出桩号、偏距、高程，这样就非常实用了。

tdl555 · 发表于 2021-11-26 11:32:19

占座支持!

技术工作室 · 发表于 2022-9-7 11:45:54

学习到很多知识，谢谢分享，支持不断完善

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

[测绘] 运用(测量员、工地通路测)格式文件绘制公路曲线

本帖子中包含更多资源

评分