本帖最后由 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)
- )
3、利用自贡黄明儒前辈的关于多线段的帖子：http://bbs.mjtd.com/thread-108149-1-1.html
;;164.19 [功能] 多段线所点击点最近的一个顶点
=>得到要移动的最近点
;;164.18 [功能] 多段线所点击子段的两端点列表
=>得到要移动最近点的选择边的二个端点 ps、pe
4、由第1步骤得到的点表ptlist移除要移动的顶点，重新用行列式得到『移除移动点后的面积』area-o2
面积差 [area-m]=[area-o2] - [area-n]
5、由移动点的位置得到前、后的二个点为sp、ep，并画直线line (e1)
以面积差[area-m]=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}/[2*)tan(θ1)+tan(θ2))]
h-={-2a-[(2a)^2-4*(tan(θ1)+tan(θ2))(-2*area-m)]^1/2}/[2*(tan(θ1)+tan(θ2))]，这个解是负数不合。
求得高之后偏移，交梯形的二边得pt1、pt2
再subst更新data就可以了。
执行成果如下：
单一点调整源码如下：
游客，本帖隐藏的内容需要发帖数高于 20 才可浏览，你当前发帖数只有 0
单一边调整源码如下：
| 
[复制链接]
发表于 2015-8-18 18:39
置顶卡
变色卡
显身卡
楼主