断面线点表生成断面挖填点表

13648893846

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

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

13648893846

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

yxh1202

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

yanshengjiang

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

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

20060510412

有个完整版的就好了

13648893846

;;[功能]两点表计算交点
;;[用法](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.2671  324.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:删除重复元素组成的表
;;;exampleBF-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

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

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

技术工作室

顶一个，期待完善