根据輸入面积调整多段线单点或单边至符合面积！！
本帖最后由 Atsai 于 2015-8-18 18:36 编辑首先是看到 树櫴希德 这个帖子http://bbs.mjtd.com/thread-169081-1-1.html
因为这个功能不一定只在测绘版块用到，所以重新贴到这里！！
单一点调整面积的思路
1、选择多线段，获取『原始面积』area-o1，以行列式读点表获取面积的方法，
以G版的代码可以实现：http://bbs.mjtd.com/forum.php?mo ... 04&page=1#pid577391;; 返回由表 L1 构成的多边形面积. 点逆时针为正，顺时针为负
;;简洁写法
(defun getplarea (l)
(* 0.5
(apply '+
(mapcar '(lambda (a b)
(- (* (car a) (cadr b)) (* (car b) (cadr a)))
)
l
(append (cdr l) (list (car l)))
)
)
)
)要获取多段线的点表则由无痕大大的：;; 獲取聚合線點表
(defun vxs (e / i v lst)
(setq i -1)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)2、输入『调整后面积』area-n
3、利用自贡黄明儒前辈的关于多线段的帖子：http://bbs.mjtd.com/thread-108149-1-1.html
;;164.19 [功能] 多段线所点击点最近的一个顶点
=>得到要移动的最近点
;;164.18 [功能] 多段线所点击子段的两端点列表
=>得到要移动最近点的选择边的二个端点 ps、pe
4、由第1步骤得到的点表ptlist移除要移动的顶点，重新用行列式得到『移除移动点后的面积』area-o2
面积差 = -
5、由移动点的位置得到前、后的二个点为sp、ep，并画直线line (e1)
以面积差=1/2*B*h =>h
offset 直线sp-ep，偏移量=h =>获取生成后的直线物件 (e2)
得到e2 的二个端点 p1、p2
6、利用 (setq pt (inters ps pe sp-el ep-el nil))，得到边上的交点pt
7、利用subst更新点表，完成。
单一边调整面积的思路也是类似的，只是求『三角形的高』，变成求『梯形的高』
area-m=1/2*(a+h*tan(θ1)+a+h*tan(θ2))*h
(tan(θ1)+tan(θ2))*h^2+2a*h-2*area-m=0
=>解1元2次方程式
h+={-2a+[(2a)^2-4*(tan(θ1)+tan(θ2))(-2*area-m)]^1/2}/
h-={-2a-[(2a)^2-4*(tan(θ1)+tan(θ2))(-2*area-m)]^1/2}/，这个解是负数不合。
求得高之后偏移，交梯形的二边得pt1、pt2
再subst更新data就可以了。
执行成果如下：
单一点调整源码如下：
**** Hidden Message *****
单一边调整源码如下：
很强大，谢谢 我发现您的这个程序在距离坐标原点附近如坐标0,0,0附近的多边形执行改程序就没有任何问题，单是离着原点（0,0,0）越远，执行程序调整面积就会出现误差，如坐标值（X/Y均为9位数）39580000,414000，请问该如何修改？谢谢 fzhemail 发表于 2019-5-4 00:00
命令: _appload 已成功加载 tmj2-单一边依面积调整多边形.lsp。 命令: ; 错误: 读入的 (八进制) 字符不正确 ...
另存为 → “编码ANSI”→就可以了。刚刚度过，可行 看着很高级, 大师的作品要支持 来看大师的作品 本帖最后由 cable2004 于 2015-8-18 21:35 编辑
还要考虑一个bug，就是当梯形两边延伸到一点后面积还达不到要求，然后转三角形延伸！ 哈哈！我是拼装众大师们的函数啦！
拼装车能开就好，要看精简的源码应该看不到！ 原来整这个呀... 看来很精练啊。来学习下。 回复一下看看，学习学习～～ 很强大，谢谢