断面线数据点表生成断面挖填点表
已有 1340 次阅读2018-9-12 22:42
|系统分类:应用|
ET, car, 数据点, 选择, 原始
;;[功能]断面数据点表生成断面填挖点表
;;[用法](LC:Section-line-ptlst-sort-lst ptlst1 ptlst2)
;;[作者]BY 老仓测绘上班记
;;;(setq ptlst1 (LC:WH-vxs (car (entsel"\n 请选择原始地貌线:"))))
;;;(setq ptlst2 (LC:WH-vxs (car (entsel"\n 请选择设计j线:"))))
;;;(PTLST1 PTLST2 / INTPTS ORIGINAL-INT DESIGN-INT I II ORIGINAL-INT-NEW JBLST WFLST TFLST INTPT DESIGN-INT1 ORIGINAL-INT1)
(defun LC:Section-line-ptlst-sort-lst (PTLST1 PTLST2 /)
(setq intpts (BF-list-delsame (LC:TWO-ptlst-inters-lst ptlst1 ptlst2 "0")0.001));交点表
(setq Original-int '() design-int '())
(setq Original-int (append Original-int ptlst1 intpts);原始地貌线总数据
design-int (append design-int ptlst2 intpts));设计线总数据
;交点及原始断面数据按Y值从小到大即断面图从左到右排序(Y值控制偏距)
(setq design-int (BF-list-delsame(vl-sort design-int '(lambda (x y) (> (car x) (car y))))0.001))
(setq Original-int (BF-list-delsame(vl-sort Original-int '(lambda (x y) (< (car x) (car y))))0.001))
(setq i 0 ii 0 Original-int-new '() wtfllst '() wflst '() tflst '())
(repeat (- (length intpts) 1)
(progn
(setq intpt1 (nth ii intpts));第ii个交点
(setq intpt2 (nth (+ ii 1) intpts));第ii个交点
(setq Original-int1 (vl-remove-if '(lambda (x) (or (<= (car x) (car(nth ii intpts))) (>= (car x) (car(nth (1+ ii) intpts))))) Original-int));原始断面线两交点之间的端点列表
(setq design-int1 (vl-remove-if '(lambda (x) (or (<= (car x) (car(nth ii intpts))) (>= (car x) (car(nth (1+ ii) intpts))))) design-int));设计线两交点之间的端点列表
;;; (setq jblst (append jblst (list (append (list intpt1) Original-int1 (list intpt2) design-int1))));把每段地面线数据及设计数据合并(append design-int1 design-int1 Original-int1)
(if (and (last design-int1) (or (> (cadr(nth ii intpts)) (cadr(last design-int1))) (> (cadr(nth (1+ ii) intpts)) (cadr(last design-int1)))))
(setq wflst (append wflst (list (append (list intpt1) Original-int1 (list intpt2) design-int1))))
(setq tflst (append tflst (list (append (list intpt1) Original-int1 (list intpt2) design-int1))))
)
)
(setq ii (1+ ii))
)
(setq wtfllst (append wtfllst (list wflst) (list tflst)));挖填总表
(princ wtfllst)
(princ)
)