chlh_jd 发表于 2012-8-5 23:45 static/image/common/back.gif
GP再改进：
1.为了适应任意管状封闭曲线, 将第一步网格数的确定方式改为自适应方式，即使用周长与面积的开 ...
感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。
chlh_jd 发表于 2012-8-5 23:45 static/image/common/back.gif
GP再改进：
1.为了适应任意管状封闭曲线, 将第一步网格数的确定方式改为自适应方式，即使用周长与面积的开 ...
感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。
highflybir 发表于 2012-8-9 10:44 static/image/common/back.gif
感谢chlh_jd 精彩的回复和改进。待有时间了，我也来完善一下。
期待大师出手，解决应用效率低问题。
斑竹客气了，还望多指教指教
改进点在任意多段线内的判断（参考狂刀的函数），去掉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_vlDx Dy Lp
List_vert_poly list_p_int P_center dist
step1 step2 t1 t2 t3t4 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
)
求arx代码
chlh_jd 发表于 2012-8-10 14:07 static/image/common/back.gif
改进点在任意多段线内的判断（参考狂刀的函数），去掉GRID+步骤，程序变得更加高效
命令: A
Select Polyline:
选择对象:
; 错误: 参数类型错误: lselsetp nil
试了各个源码均出错，不知是什么原因，请指点，谢谢
下了就要顶！！
vl vla vlax 这些函数能力强劲！资料·····
强大....我想要找多义线最窄处，不知有没有思路....