明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1173|回复: 3

[函数] 断面数据点表生成断面清表面积

[复制链接]
发表于 2018-10-14 22:11 | 显示全部楼层 |阅读模式
;;[功能]断面数据点表生成断面清表面积
;;[用法](LC:Clear-table-area ptlst1 ptlst2 qbhd)
;;[作者]BY 老仓测绘上班记
;;;(setq ptlst1 (LC:WH-vxs (car (entsel"\n 请选择原始地貌线:"))))
;;;(setq ptlst2 (LC:WH-vxs (car (entsel"\n 请选择设计线:"))))
;;;(LC:Make-LWPOLYLINE '((185.938 88.6237 0.0) (201.505 75.1854 0.0) (222.674 86.7311 0.0) (240.506 96.4565 0.0) (253.083 87.6859 0.0) (265.209 79.2298 0.0) (279.615 83.7696 0.0) (298.661 89.7715 0.0) (307.273 82.7743 0.0) (322.078 70.7451 0.0) (331.196 85.7035 0.0) (339.319 99.0276 0.0) (371.204 89.63 0.0) (388.08 84.6558 0.0) (408.176 92.5894 0.0) (440.832 105.482 0.0) (445.743 92.0401 0.0) (445.743 91.7401 0.0) (440.832 105.182 0.0) (408.176 92.2894 0.0) (388.08 84.3558 0.0) (371.204 89.33 0.0) (339.319 98.7276 0.0) (331.196 85.4035 0.0) (322.078 70.4451 0.0) (307.273 82.4743 0.0) (298.661 89.4715 0.0) (279.615 83.4696 0.0) (265.209 78.9298 0.0) (253.083 87.3859 0.0) (240.506 96.1565 0.0) (222.674 86.4311 0.0) (201.505 74.8854 0.0) (185.938 88.3237 0.0)))
;;;(setq qbhd (getreal "\n 请输入清表层厚度 :"))
(defun LC:Clear-table-area (PTLST1 PTLST2 QBHD / INTPTS ORIGINAL-INT QBLST QBLST1 QBLST2 QBMJ)
  (setq intpts (BF-list-delsame (LC:TWO-ptlst-inters-lst ptlst1 ptlst2 "0")0.001));交点表
  (setq intpts (BF-list-delsame(vl-sort intpts '(lambda (x y) (< (car x) (car y))))0.001));交点按Y值从小到大即断面图从左到右排序(Y值控制偏距)
  (setq Original-int '() qblst '())
  (setq Original-int (append Original-int ptlst1 intpts));原始地貌线总数据
  ;交点及原始断面数据按Y值从小到大即断面图从左到右排序(Y值控制偏距)
  (setq Original-int (BF-list-delsame(vl-sort Original-int '(lambda (x y) (< (car x) (car y))))0.001))
  (setq qblst1 (vl-remove-if  '(lambda (x) (or (<(car x) (car(car intpts)))(> (car x) (car(last intpts))))) Original-int));要清表的原始数据
  (setq qblst2 (mapcar '(lambda (x) (list (car x) (- (cadr x) qbhd)  (caddr x))) qblst1))
  (setq qblst2 (BF-list-delsame(vl-sort qblst2 '(lambda (x y) (> (car x) (car y))))0.001))
  (setq qblst (append qblst qblst1 qblst2))
  (setq qbmj (abs(LC:lst-getarea qblst)))
  ;(setq blxs (apply'* (mapcar '(lambda(x)(/ 1000.0 x)) (list hxbl zxbl))));不等比例缩放系数  
)
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2018-10-15 07:38 | 显示全部楼层
老仓老师辛苦了!谢谢提供源码
发表于 2018-10-15 15:34 | 显示全部楼层
仓老师辛苦了
发表于 2020-11-4 09:50 | 显示全部楼层
没有函数LC:WH-vxs
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 23:03 , Processed in 0.194352 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表