多边形的最大内接圆

highflybir · 发表于 2012-8-9 10:44:23

chlh_jd 发表于 2012-8-5 23:45
GP再改进：
1.为了适应任意管状封闭曲线, 将第一步网格数的确定方式改为自适应方式，即使用周长与面积的开 ...

感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。

highflybir · 发表于 2012-8-9 10:44:13

chlh_jd 发表于 2012-8-5 23:45
GP再改进：
1.为了适应任意管状封闭曲线, 将第一步网格数的确定方式改为自适应方式，即使用周长与面积的开 ...

感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。

690994 · 发表于 2012-8-9 12:16:38

highflybir 发表于 2012-8-9 10:44
感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。

期待大师出手，解决应用效率低问题。

chlh_jd · 发表于 2012-8-10 12:43:07

斑竹客气了，还望多指教指教

chlh_jd · 发表于 2012-8-10 14:07:44

改进点在任意多段线内的判断（参考狂刀的函数），去掉GRID+步骤，程序变得更加高效

;;; maximum circle inscribed in a closed polyline
;;; writed by Gian Paolo Cattaneo
;;; edited by GSLS(SS) 2012-8-5
(defun C:TesT (/ POLY POLY_vl Dx Dy Lp
List_vert_poly list_p_int P_center dist
step1 step2 t1 t2 t3 t4 R0 area
len i
)
(gc)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1)
(setq area (vlax-curve-getArea poly)
len (vlax-curve-getDistAtParam
poly
(vlax-curve-getEndParam poly)
)
)
(setq step1 (max 10 (fix (/ len 0.4 (sqrt area))))) ;_--> grid_1
(setq step2 10) ;_--> grid_2
(setq list_vert_poly (LWPoly->List POLY 10))
(grid_1)
(setq t1 (getvar "MilliSecs"))
(Point_int)
(setq t2 (getvar "MilliSecs"))
;|
(foreach a list_p_int
(entmake (list (cons 0 "POINT")
(cons 10 a)
(cons 62 3))))|;
;_(grid+)
(Point_center)
(setq t3 (getvar "MilliSecs"))
(setq i 0)
(while (and (> (- Dist R0) 1e-8) (< i 10))
(grid_2)
(Point_center)
(setq i (1+ i))
)
(setq t4 (getvar "MilliSecs"))
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(princ
(strcat "\ntime1 = " (rtos (- t2 t1) 2 0) " MilliSecs")
)
(princ
(strcat "\ntime2 = " (rtos (- t3 t2) 2 0) " MilliSecs")
)
(princ
(strcat "\ntime3 = " (rtos (- t4 t3) 2 0) " MilliSecs")
)
(princ)
)
)
)
;; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
;; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ p1 p2 X1 Y1 l1)
(vla-getboundingbox (vlax-ename->vla-object POLY) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
(setq Dx (/ (- (car p2) (car p1)) step1))
(setq Dy (/ (- (cadr p2) (cadr p1)) step1))
(setq Lp (list p1)
X1 (car p1)
Y1 (cadr p1)
)
(repeat step1
(setq Lp (cons (list (setq X1 (+ X1 Dx)) Y1) Lp))
)
(setq Lp (list Lp))
(repeat step1
(setq Lp (cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car lp)
)
Lp
)
)
)
(setq Lp (apply (function append) Lp))
)
;; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
;; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ X1 Y1 P1)
(setq list_p_int nil
X1 (- (car P_center) Dx)
Y1 (- (cadr P_center) Dy)
P1 (list X1 Y1)
Dx (/ (* 2 Dx) step2)
Dy (/ (* 2 Dy) step2)
)
(setq list_p_int (list P1))
(repeat step2
(setq list_p_int (cons (list (setq X1 (+ X1 Dx)) Y1) list_p_int))
)
(setq list_p_int (list list_p_int))
(repeat step2
(setq list_p_int
(cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car list_p_int)
)
list_p_int
)
)
)
(setq list_p_int (apply (function append) list_p_int))
)
;; restituisce la lista dei punti interni ad un poligono
;; dati: - lista coordinate dei punti -> Lp
;; - lista coordinate vertici poligono -> list_vert_poly
;; Returns the list of points inside the polyline
(defun Point_int ()
(setq list_p_int
(vl-remove-if-not
(function
(lambda (pt)
;_determine point in curve , use widding number
(equal
PI
(abs
(apply
(function +)
(mapcar (function (lambda (x y / a)
(rem (- (angle pt x) (angle pt y)) PI)
)
)
list_vert_poly
(cdr list_vert_poly)
)
)
)
1e-8
)
)
)
Lp
)
)
)
;; Infittisce la griglia inserendo altri punti
;; nel centro delle diagonali tra i punti interni
;; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda (x)
(list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))
)
list_p_int
)
)
(setq list_p_int (append G+ list_p_int))
)
;; Da una lista di punti restituisce quello più lontano da un oggetto
;; dati: - lista dei punti -> list_p_int
;; - oggetto -> POLY_vl
;; Returns the farthest point from the polyline
(defun Point_center (/ Pa Pvic)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo Poly Pa))
(if (> (distance Pa Pvic) Dist)
(setq P_center Pa
R0 Dist
Dist (distance Pa Pvic)
)
)
)
)
;;
(defun LWPoly->List (en acc / a b vetex bu p1 p2 l r ang an1 N)
;;Acc --- 0 ~ 99
(setq ent (entget en))
(while (setq ent (member (assoc 10 ent) ent))
(setq b (cons (cdar ent) b)
ent (member (assoc 42 ent) ent)
b (cons (cdar ent) b)
ent (cdr ent)
vetex (cons b vetex)
b nil
)
)
(while vetex
(setq a (car vetex)
vetex (cdr vetex)
bu (car a)
p1 (cadr a)
)
(if l
(setq p2 (car l))
(setq p2 (cadr (last vetex))
l (cons p2 l)
)
)
(if (equal bu 0 1e-6)
(setq l (cons p1 l))
(progn
(setq ang (* 2 (atan bu))
r (/ (distance p1 p2)
(* 2 (sin ang))
)
c (polar p1
(+ (angle p1 p2) (- (/ pi 2) ang))
r
)
r (abs r)
ang (abs (* ang 2.0))
N (abs (fix (/ ang 0.0174532925199433)))
N (min N (1+ Acc))
)
(if (= N 0)
(setq l (cons p1 l))
(progn
(setq an1 (/ ang N)
ang (angle c p2)
)
(if (not (minusp bu))
(setq an1 (- an1))
)
(repeat (1- N)
(setq ang (+ ang an1)
l (cons (polar c ang r) l)
)
)
(setq l (cons p1 l))
)
)
)
)
)
l
)

;;; maximum circle inscribed in a closed polyline 
;;; writed by Gian Paolo Cattaneo 
;;; edited by GSLS(SS) 2012-8-5 
 
(defun C:TesT (/        POLY         POLY_vl  Dx           Dy            Lp 
               List_vert_poly         list_p_int           P_center dist 
               step1        step2         t1          t2        t3  t4    R0            area 
               len        i          
              ) 
  (gc) 
  (prompt "\nSelect Polyline: ") 
  (if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0)) 
    (progn 
      (setq i 1) 
      (setq area (vlax-curve-getArea poly) 
            len         (vlax-curve-getDistAtParam 
                   poly 
                   (vlax-curve-getEndParam poly) 
                 ) 
      ) 
      (setq step1 (max 10 (fix (/ len 0.4 (sqrt area))))) ;_--> grid_1       
      (setq step2 10) ;_--> grid_2 
      (setq list_vert_poly (LWPoly->List POLY 10))       
      (grid_1) 
      (setq t1 (getvar "MilliSecs")) 
      (Point_int) 
      (setq t2 (getvar "MilliSecs")) 
      ;| 
      (foreach a list_p_int 
        (entmake (list (cons 0 "POINT") 
                       (cons 10 a) 
                       (cons 62 3))))|; 
      ;_(grid+) 
      (Point_center) 
      (setq t3 (getvar "MilliSecs")) 
      (setq i 0) 
      (while (and (> (- Dist R0) 1e-8) (
        (grid_2) 
        (Point_center) 
        (setq i (1+ i)) 
      ) 
      (setq t4 (getvar "MilliSecs")) 
      (entmake 
        (list 
          (cons 0 "CIRCLE") 
          (cons 10 P_center) 
          (cons 40 dist) 
        ) 
      ) 
      (princ 
        (strcat "\ntime1 = " (rtos (- t2 t1) 2 0) " MilliSecs") 
      ) 
      (princ 
        (strcat "\ntime2 = " (rtos (- t3 t2) 2 0) " MilliSecs") 
      ) 
      (princ 
        (strcat "\ntime3 = " (rtos (- t4 t3) 2 0) " MilliSecs") 
      ) 
      (princ) 
    ) 
  ) 
) 
 
;; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata 
;; Returns a grid of points within the BoundingBox of the selected poly 
(defun grid_1 (/ p1 p2 X1 Y1 l1) 
  (vla-getboundingbox (vlax-ename->vla-object POLY) 'p1 'p2) 
  (setq        p1 (vlax-safearray->list p1) 
        p2 (vlax-safearray->list p2) 
        p1 (list (car p1) (cadr p1)) 
        p2 (list (car p2) (cadr p2)) 
  ) 
  (setq Dx (/ (- (car p2) (car p1)) step1)) 
  (setq Dy (/ (- (cadr p2) (cadr p1)) step1)) 
  (setq        Lp (list p1) 
        X1 (car p1) 
        Y1 (cadr p1) 
  ) 
  (repeat step1 
    (setq Lp (cons (list (setq X1 (+ X1 Dx)) Y1) Lp)) 
  ) 
  (setq Lp (list Lp)) 
  (repeat step1 
    (setq Lp (cons (mapcar (function (lambda (x) 
                                       (list (car x) (+ (cadr x) Dy)) 
                                     ) 
                           ) 
                           (car lp) 
                   ) 
                   Lp 
             ) 
    ) 
  ) 
  (setq Lp (apply (function append) Lp)) 
) 
;; Restituisce una griglia di punti intorno al punto centrale (provvisorio) 
;; Returns a grid of points around the center point (provisional) 
(defun grid_2 (/ X1 Y1 P1) 
  (setq        list_p_int nil 
        X1           (- (car P_center) Dx) 
        Y1           (- (cadr P_center) Dy) 
        P1           (list X1 Y1) 
        Dx           (/ (* 2 Dx) step2) 
        Dy           (/ (* 2 Dy) step2) 
  ) 
  (setq list_p_int (list P1)) 
  (repeat step2 
    (setq list_p_int (cons (list (setq X1 (+ X1 Dx)) Y1) list_p_int)) 
  ) 
  (setq list_p_int (list list_p_int)) 
  (repeat step2 
    (setq list_p_int 
           (cons (mapcar (function (lambda (x) 
                                     (list (car x) (+ (cadr x) Dy)) 
                                   ) 
                         ) 
                         (car list_p_int) 
                 ) 
                 list_p_int 
           ) 
    ) 
  ) 
  (setq list_p_int (apply (function append) list_p_int)) 
) 
;; restituisce la lista dei punti interni ad un poligono 
;; dati:  - lista coordinate dei punti -> Lp 
;;        - lista coordinate vertici poligono -> list_vert_poly 
;; Returns the list of points inside the polyline 
(defun Point_int () 
  (setq        list_p_int 
         (vl-remove-if-not 
           (function 
             (lambda (pt) 
               ;_determine point in curve , use widding number 
               (equal 
                 PI 
                 (abs 
                   (apply 
                     (function +) 
                     (mapcar (function (lambda (x y / a) 
                                         (rem (- (angle pt x) (angle pt y)) PI) 
                                       ) 
                             ) 
                             list_vert_poly 
                             (cdr list_vert_poly) 
                     ) 
                   ) 
                 ) 
                 1e-8 
               ) 
             ) 
           ) 
           Lp 
         ) 
  ) 
) 
;; Infittisce la griglia inserendo altri punti 
;; nel centro delle diagonali tra i punti interni 
;; Insert points (interior) to increase the density of the grid 
(defun grid+ (/ G+) 
  (setq        G+ 
         (mapcar '(lambda (x) 
                    (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2))) 
                  ) 
                 list_p_int 
         ) 
  ) 
  (setq list_p_int (append G+ list_p_int)) 
) 
;; Da una lista di punti restituisce quello più lontano da un oggetto 
;; dati:  - lista dei punti -> list_p_int 
;;        - oggetto -> POLY_vl 
;; Returns the farthest point from the polyline 
(defun Point_center (/ Pa Pvic) 
  (foreach Pa list_p_int 
    (setq Pvic (vlax-curve-getClosestPointTo Poly Pa)) 
    (if        (> (distance Pa Pvic) Dist) 
      (setq P_center Pa 
            R0             Dist 
            Dist     (distance Pa Pvic) 
      ) 
    ) 
  ) 
) 
;; 
(defun LWPoly->List (en acc / a b vetex bu p1 p2 l r ang an1 N) 
  ;;Acc --- 0 ~ 99 
  (setq ent (entget en)) 
  (while (setq ent (member (assoc 10 ent) ent)) 
    (setq b        (cons (cdar ent) b) 
          ent        (member (assoc 42 ent) ent) 
          b        (cons (cdar ent) b) 
          ent        (cdr ent) 
          vetex        (cons b vetex) 
          b        nil 
    ) 
  ) 
  (while vetex 
    (setq a        (car vetex) 
          vetex        (cdr vetex) 
          bu        (car a) 
          p1        (cadr a) 
    ) 
    (if        l 
      (setq p2 (car l)) 
      (setq p2 (cadr (last vetex)) 
            l  (cons p2 l) 
      ) 
    ) 
    (if        (equal bu 0 1e-6) 
      (setq l (cons p1 l)) 
      (progn 
        (setq ang (* 2 (atan bu)) 
              r          (/ (distance p1 p2) 
                     (* 2 (sin ang)) 
                  ) 
              c          (polar p1 
                         (+ (angle p1 p2) (- (/ pi 2) ang)) 
                         r 
                  ) 
              r          (abs r) 
              ang (abs (* ang 2.0)) 
              N          (abs (fix (/ ang 0.0174532925199433))) 
              N          (min N (1+ Acc)) 
        ) 
        (if (= N 0) 
          (setq l (cons p1 l)) 
          (progn 
            (setq an1 (/ ang N) 
                  ang (angle c p2) 
            ) 
            (if        (not (minusp bu)) 
              (setq an1 (- an1)) 
            ) 
            (repeat (1- N) 
              (setq ang        (+ ang an1) 
                    l        (cons (polar c ang r) l) 
              ) 
            ) 
            (setq l (cons p1 l)) 
          ) 
        ) 
      ) 
    ) 
  ) 
  l 
)

c735023723 · 发表于 2012-8-24 08:12:39

求arx代码

ynhh · 发表于 2012-10-24 13:39:10

chlh_jd 发表于 2012-8-10 14:07
改进点在任意多段线内的判断（参考狂刀的函数），去掉GRID+步骤，程序变得更加高效

命令: A
Select Polyline:
选择对象:
; 错误: 参数类型错误: lselsetp nil

试了各个源码均出错，不知是什么原因，请指点，谢谢

zyhandw · 发表于 2012-10-24 14:38:09

下了就要顶！！

aaacjh · 发表于 2012-10-24 18:27:56

vl vla vlax 这些函数能力强劲！资料·····

logoin · 发表于 2012-10-24 19:42:48

强大....我想要找多义线最窄处，不知有没有思路....

账号		自动登录	找回密码
密码			注册

多边形的最大内接圆

本帖子中包含更多资源