[求助]求多边形内点！ 紧急！！！

tchen

问题是这样：

     能否在多边形内部产生内点，不管多边形是凹还是凸，都能产生的这个点在多边形内！因为我有一个CAD图形涉及到

     很多多边形需要  内部标号的问题，所以想起来没有好的简单的方法！

    虽然网站里面有人发了此话题，但是未给出源代码和解答思路，我自己尝试了用面域中心和一些方法都不行，

   所以看大家能否想出一个解答方法，最好是有理论依据的，比较好的解法！

zhang007

呵呵，我也不知道，但是帮你顶一下

luyu9635

你可以看看我这个程序，可能对你有用，思路是先选取对象，然后取对象的左下角点和右上角点，通过这两点就可以求出中心点，一般都是这个图形的一个内部点，至少我还没有发现不是的情况，代码如下:

;选择1往外偏移（对象无内外之分的也选此项）/选择2往内偏移
 ;命令为qq
 
 ;选择1往外偏移（对象无内外之分的也选此项）/选择2往内偏移
 ;命令为qq
 
(defun c:qq (/ ss JL FX n nw col cs jll)
  (princ "\n★多对象偏移★\n选择偏移对象...")
  (and
    (setq ss (ssget))
    (> (setq jl (getdist "\n输入偏移距离：")) 0)
    (> (setq cs (getint"\n请输入偏移次数<黪认为1>:"))))
    (initget "1 2")
    (setq nw (getkword"\n 请选择偏移方式：1-往外/2-往内:"))
    (setq col (getint"\n请选择偏移颜色号:1红-2黄-3绿-4青-5蓝-6紫-7白:"))
      (if (not cs )
     (setq cs 1))
    (setq n 0 )
        (cond ((= nw "1")
              (setq fx (getpoint "\n请点选偏移的外侧："))
              (repeat (sslength ss)
        (setq jll jl)
                      (setq dx (ssname ss n))
        (repeat cs
        (command "offset" jll dx fx "")
        (vl-cmdf "chprop" (entlast) "" "c" col "")
   (setq jll (+ jll jl)))
        (setq n (1+ n))
       ))
              ((= nw "2")
              (repeat (sslength ss)
    (setq jll jl)
                  (setq dx (ssname ss n))
                  (setq p1 (car(acet-ent-geomextents  dx)) p1 (list (car p1) (cadr p1))
                 p2 (cadr(acet-ent-geomextents  dx)) p2 (list (car p2) (cadr p2));看这一句
                 fx (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))；还有这一句
    (repeat cs
           (command "offset" jll dx fx "")
    (vl-cmdf "chprop" (entlast) "" "c" col "")
      (setq jll (+ jll jl)))
                  (setq n (1+ n))
              ))
        )
    (princ "\n★成功完成!!" )
    (princ)
)

xgr

这是从网站下载的取得实体的面积或质量的中点的程序，我没用过，供你参考！

tchen

谢谢 收到 不过觉得没什么用

xbtang

如果是U形件或其他就没有用了，pressCAD的自动穿线孔功能可以实现。

tchen

楼上的  我想自己写这个代码

y_do

先顶后下，看看能用不，正需要

yanguangfei

(defun MJ:MIDPOINT (P1 P2)
  (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)


(defun vl-removes (lst / lst)
    (foreach  X lst
        (setq lst (append (vl-remove X lst) (list X)))
    )
)

;;;求多边形内相对中心点[V 1.0]
;;; 2012-11-15
;;; 感谢 辰     提供方法
;;; 感谢 学院派 指正
;;;  by yanguangfei
(defun Get_center_relative (ename /  Pts   2R Mk  Mkline points DelLine Tssred
                   i   lst  N  Newlst    DistList  TssSub   R   Number  Tssbak   Pt)
    (setq Obj     (Vlax-Ename->Vla-Object ename)
          Tssbak  (Vlax-Get Obj 'Thickness )
          TssSub  (Vlax-Put Obj 'Thickness 0 ))
    (setq Pts     (GetBoundingBox ename)
          2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))
          Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))
          Mkline  (entlast)
          points  (vlax-invoke Obj 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
          Tssred  (Vlax-Put Obj 'Thickness (eval Tssbak) )
          DelLine (entdel Mkline)
          i       0
          lst     nil
          )
  (repeat (/ (length points) 3)
       (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
       (setq i (+ i 3))
  )
  (setq lst (px lst))
  (if (>= (length lst) 4)
      (progn
          (setq N      0
                Newlst nil)
          (repeat (/ (length lst) 2)
              (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
              (setq N (+ 2 N))
          )
          (setq DistList nil
                R        0)
          (repeat (length Newlst)
            (setq Number (nth R Newlst)
                  DistList (append DistList  (list(distance (car Number) (cadr Number)))))
            (setq R (1+ R))
          )
          (setq  Pt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
        (MJ:MIDPOINT (car pt) (cadr pt));返回值
      )
      (MJ:MIDPOINT (car lst) (cadr lst));返回值
  )
)

(defun px (X)
    (vl-sort  X
             (function (lambda (e1 e2)