运用(测量员、工地通路测)格式文件绘制公路曲线
本帖最后由 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)
(ifang
(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)
)
)
)
(ifrotate_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_rT_r-1
T_offset T_reflelx
)
(ifang
(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)
)
)
)
(setqT_综合
(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
)
)
楼主对一个程序不断完善，孜孜不倦的精神，值得学习。:victory: 谢谢楼主分享 感谢支持， 。 支持楼主 大神可以提取出单个点中桩坐标计算的吗 大神呀，大神万岁 很不错，希望能增加一个功能，在图上识取一个坐标，然后就可以反算出桩号、偏距、高程，这样就非常实用了。 占座支持! 学习到很多知识，谢谢分享，支持不断完善
页:
[1]