怎样用一条直线按面积比例分割任意形状多边形？想了很久，还是没思路

star_sur

用一条已知直线按面积比例分割任意形状多边形
例如上图，用已知直线把面积115平方米的多边形，分割成15平方，20平方，30平方，最后余下50平方，求出每一块的各个顶点，例如30平方那块的顶点，p1 p2 p3 p4 p5 p6.
想了很长时间了，也查了大量的网页，还是没有思路，恳请大侠出手。

song宋_74729

(vl-load-com)
(defun ebox (e / pa pb)
         (Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
             (setq pa (trans (vlax-safearray->list pa) 0 1)
                   pb (trans (vlax-safearray->list pb) 0 1)
             )
             (list pa pb)
)
(defun cbox (e / box)
         (setq box (ebox e))
         (mid (car box) (cadr box))
)
(defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))
(defun mktext (str pt th)
  (entmake (list '(0 . "TEXT")
                 (cons 1 str)
                 (cons 10 pt)
                 (cons 40 th)
                 (cons 11 pt)
                 (cons 71 0)
                 (cons 72 1)
                 (cons 73 2)
           )
  )
)
(defun str2lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (str2lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)
(defun ptscen (Pts / )
  (MAT:vxs (apply 'mapcar (cons '+ pts)) (/ 1.0 (length pts)))
)
(defun MAT:vxs ( v s )
  (mapcar (function (lambda ( n ) (* n s))) v)
)
(defun dxf (key ename) (cdr (assoc key (entget ename))))
(defun 2epi ( e1 e2 mode / l r )
    (setq obj1 (vlax-ename->vla-object e1)
            obj2 (vlax-ename->vla-object e2)
            l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)
(defun p2ld (pt p1 p2 / )
  (car (trans (mapcar '- pt p1) 0 (mapcar '- p2 p1)))
)
(defun gvp (e)
        (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (trans (cdr x) 0 1))) (entget e)))
)
(defun mkline (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))))
(defun new_ss (lastobj / ss obj)
  (setq ss (ssadd))
        (setq obj (entnext lastobj))
        (while obj
            (setq ss (ssadd obj ss))
            (setq obj (entnext obj))
        )
ss
)
(defun ss2lst ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (ssname ss (setq i (1- i))) l))
        )
    )
)
(defun c:tt ( / a angint ar ar1 bang box cont dd dh dx e e0 ee h h1 lm lstr0 m1 n odlst p1 p2 pa pb pc pm pm1 pts ssn str tm w x)
(progn
(vl-load-com)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq cont T)
  (while cont
    (setq str (getstring "\n输入面积划分表<800.22,200,330.45...>"))
    (if (/= str "")(setq cont nil))
  )
        (setq lstr0 (mapcar 'atof (str2lst str ","))
                n (apply '+ lstr0)
                e (car (entsel "\n选择多段线:"))
                p1 (getpoint "\n地块划分起点:")
                p2 (getpoint p1 "\n划分方向:")
                bang (angle p1 p2)
                pc (ptscen (gvp e))
                ar (Vlax-Get (Vlax-Ename->Vla-Object e) 'Area )
                lstr0 (mapcar '(lambda(x) (* x (/ ar n))) lstr0)
                lstr0 (reverse (cdr (reverse lstr0)))
                angint (atof (angtos bang 0 4))
                lm nil
                ee (entlast)
        )
        (vl-cmdf "_.rotate" e "" pc (- 90. angint))
        (setq box (ebox e)
                p1 (car box)
                p2 (cadr box)
)
(mapcar 'set '(w h) (mapcar '- p2 p1))
(vla-copy (vlax-ename->vla-object e))
(setq e0 (entlast))
(entdel e0)
)
        (foreach a lstr0
        (setq dh (/ a w)
                pa (mapcar '+ p1 (list 0 dh))
                pb (mapcar '+ p1 (list w dh))
                tm (mkline (mapcar '- pa (list 10 0)) (mapcar '+ pb (list 10 0)))
                pts (2epi tm e 0)
                pm (mid (car pts) (last pts))
                pm1 (mapcar '- pm (list 0 (* 0.5 dh)))
        )
        (vl-cmdf "boundary" "a" "b" "n" e tm "" "" pm1 "")
        (setq m1 (entlast)
                ar1 (Vlax-Get (Vlax-Ename->Vla-Object m1) 'Area )
                dx (- a ar1)
                dd (/ dx w 2.)
        )
        (while (not (equal dx 0 1e-3))
        (mapcar 'entdel (list tm m1))
        (setq pa (mapcar '+ pa (list 0 dd))
                pb (mapcar '+ pb (list 0 dd))
                tm (mkline pa pb)
                pts (2epi tm e 0)
                pm (mid (car pts) (last pts))
                pm1 (mapcar '- pm (list 0 (* 0.5 dh)))
                )
        (vl-cmdf "boundary" "a" "b" "n" e tm "" "" pm1 "")
        (setq m1 (entlast)
                ar1 (Vlax-Get (Vlax-Ename->Vla-Object m1) 'Area )
                dx (- a ar1)
                dd (/ (abs dx) w 2.)
        )
        )
        (vl-cmdf "boundary" "a" "b" "n" e tm "" "" (mapcar '+ pm (list 0 (* 0.5 dh))) "")
(mapcar 'entdel (list e tm m1))
(setq e (entlast)
        h1 (abs (p2ld p1 pa pb))
        p1 (mapcar '+ p1 (list 0 h1))
        lm (cons pts lm)
)
)
(mapcar '(lambda(x) (mkline (car x) (cadr x))) lm)
(mapcar 'entdel (list e e0))
(setq ssn (new_ss ee))
(vl-cmdf "_.rotate" e0 ssn "" pc (- (- 90. angint)))
(mapcar 'setvar '("cmdecho" "osmode") odlst)
)



试试看 参考

wuyunpeng888

如果要求右边的区域就把直线左边的点都移到直线上，或把直线上的都删掉，剩下的多边型的面积就是你要的了

wuyunpeng888

相当于用顶点做一个环形连表，然后在直线左边的都删掉，和直线相交的两点连起来就是了

los_su

首先，已知多边形的各个顶点坐标，然后求各个顶点到已知线的垂直距离，把每个顶点按距离排序成Piont（1）、piont（2）、、、。然后做已知线的平行线相交与piont（n），分别为line（1）、line（2）、、、。再求两条相邻的line（n）和多边形组成的新多边形的面积area（1）、areas（2）、、、。
然后判断要求分割的面积处于哪个area（n）的区间内。。最后去求分割线。

poly168

这个只能用渐近法去计算,首先取得已知直线的两个端点坐标和闭合线各个顶点坐标.然后计算闭合线上各项点到直线的垂直距离，找到最小的垂直距离，,判断闭合线是在直线左边还是右边，然后按从这个项点计算出平行线方向，计算出射线与闭合线的交点与其它点组成一个闭合图形，计算面积,如果面积小于高定的值就把平行线往另一个方向移动一个固定值，直到计算出的面积达到设计值为止。移动间距可以动态调整，当分割出来的面积与设计面积大于设计面积时可用多出来的部份除以直线与闭合图形交点长度计算下一个偏移量，不断循环下去直到误差达到许可值

star_sur

没有一个正合适的解？

chbddzx12

顶~~~~~~~~~~~~~~~~~~~

373294296

  这个怎么老师来回答了？？？？

zzyong00

这个也没什么呀，原楼主已多年没音信了，懒得回复而已
如果封闭区域是闭合多线段，首先，求出直线和pl的交点
然后求交点分别在pl线的coordinate点的哪个位置
最后用辛普森面积法求出面积