社区 › AutoLISP/Visual LISP 编程技术 › 断面线点表生成断面挖填点表

13648893846 发表于 2018-9-21 11:22:02

hao3ren 发表于 2018-9-15 21:53
搜过了，没找到

多段线顶点函数，交点函数随后把更新套上断面比例的也发上来

13648893846 发表于 2018-9-21 11:29:12

期间得到院长73哥大海哥大量帮助在此表示感谢

yxh1202 发表于 2018-10-17 15:40:58

仓老师厉害了，我们算工程量的十分需要。我原来编写到多个线段自动求面积，一直没有成功

yanshengjiang 发表于 2018-11-12 14:05:18

13648893846 发表于 2018-9-21 11:19
工作之余逐步写函数完善CASS任意断面法功能，太菜可能要很长一段时间

南方cass生成里程文件的时候，是按距离采样。不能按实际地形点采样。目前我已经写了一个根据图面实际高程点采样的插件

20060510412 发表于 2018-11-12 14:20:31

有个完整版的就好了

13648893846 发表于 2018-11-13 17:58:14

;;[功能]两点表计算交点
;;[用法](LC:TWO-ptlst-inters-lst ptlst1 ptlst2 "0")
;;[作者]BY 老仓测绘上班记
;;说明:得到两个二维点表的交点
;;用非vla-IntersectWith方法不生成对象写的点表交点函数，可选多种延长方向，两点表都可以选择是否双向延长还是各自单向延长
;;参数:lst1:点表1
;;参数:lst2:点表2
;;参数:typ:延长类型（不区别大小写）："0000"或其他—两个都不延长;"0001"—延长点表2右侧两个点; "0010"—延长点表2左侧两个点； "0011"—延长点表2两侧两个点; "1000"—延长点表1左侧两个点; "0100"—延长点表1右侧两个点；"1100"—延长点表1两侧两个点;"1111"—延长点表1和点表2两侧两个点;
;;返回:符合条件的包括所有交点的二维点表
;;示例
;;;(setq ptlst1 (LC:WH-vxs (car (entsel"\n 请选择原始地貌线："))))
;;;(setq ptlst2 (LC:WH-vxs (car (entsel"\n 请选择设计j线："))))
;(setq lst1 (list (list 1492.5310 356.4799) (list 1693.9629 457.0300) (list 2085.9058 466.7216) (list 2281.2705 367.3829)))
      ;(setq lst2 (list (list 1567.8204 362.9696) (list 1667.2671324.9823) (list 1980.3360 258.3527) (list 2205.2348 357.8477)))
      ;(setq typ "0011")
;(LC:TWO-ptlst-inters-lst lst1 lst2 typ)
;((1532.53 376.449) (2255.92 380.272))
(defun LC:TWO-ptlst-inters-lst (lst1 lst2 typ / ii jj pt1 pt2 pt3 pt4 azi intpt interpt)
   (setq ii (length lst1))
   (setq jj (length lst2))
;延长lst1左侧
(if (= (substr typ 1 1) "1")
    (progn
   (setq pt1 (nth 0 lst1))
   (setq pt2 (nth 1 lst1))
   (setq azi (angle pt1 pt2))
   (setq azi (+ pi azi))
   (setq lst1 (append (list (polar pt1 azi 10000) ) lst1 ))
    )
)
;延长lst1右侧
(if (= (substr typ 2 1) "1")
    (progn
   (setq pt1 (nth (1- ii) lst1))
   (setq pt2 (nth ii lst1))
   (setq azi (angle pt1 pt2))
   (setq lst1 (append lst1 (list (polar pt2 azi 10000) ) ))
    )
)
;延长lst2左侧
(if (= (substr typ 3 1) "1")
    (progn
   (setq pt3 (nth 0 lst2))
   (setq pt4 (nth 1 lst2))
   (setq azi (angle pt3 pt4))
   (setq azi (+ pi azi))
   (setq lst2 (append (list (polar pt3 azi 10000) ) lst2 ))
    )
)
;延长lst2右侧
(if (= (substr typ 4 1) "1")
    (progn
   (setq pt3 (nth (1- jj) lst2))
   (setq pt4 (nth jj lst2))
   (setq azi (angle pt3 pt4))
   (setq lst2 (append lst2 (list (polar pt4 azi 10000) ) ))
    )
)
;计算交点坐标
   (setq ii (1- (length lst1)))
   (setq jj (1- (length lst2)))
   (setq intpt nil interpt nil i 0 )
   (while (< i ii)
   (setq pt1 (nth i lst1))
   (setq pt2 (nth (1+ i) lst1))
   (setq j 0)
   (while (< j jj)
       (setq pt3 (nth j lst2))
       (setq pt4 (nth (1+ j) lst2))
       (setq intpt (inters pt1 pt2 pt3 pt4 t) )
       (if (/= intpt nil)
         ;将交点坐标存入点表
         (setq interpt (append interpt (list intpt)))
       )
       (setq j (1+ j))
   )
   (setq i (1+ i))
   )
interpt
)


;;;name:BF-list-delsame
;;;desc:删除表中相同元素，保留第一次出现的位置
;;;arg:lst:列表
;;;arg:buzz:容差
;;;return:删除重复元素组成的表
;;;example:(BF-list-delsame '(0 1 2 3 2 4 4) 0.1)---->(0 1 2 3 4)
(defun BF-list-delsame (lst buzz)
(if Lst
    (cons (car Lst)
          (BF-list-delsame
          (vl-remove-if
              '(lambda (x) (equal (car lst) x buzz))
              (cdr lst)
          )
          buzz
          )
    )
)
)

13648893846 发表于 2018-12-6 18:29:16

yanshengjiang 发表于 2018-11-12 14:05
南方cass生成里程文件的时候，是按距离采样。不能按实际地形点采样。目前我已经写了一个根据图面实际高 ...

不能按实际距离采样是因为使用了破解版cass

技术工作室 发表于 2022-9-3 10:25:41

顶一个，期待完善

查看完整版本: 断面线点表生成断面挖填点表