最大内接圆

newer

原帖地址在哪？ 没太看明白你的图。

zdqwy19

自己用手绘好了
选择一个多段线

选择命令->偏移->通过->看到图形变成三角形时，确定

利用修剪、圆、直线命令绘制三角形内接圆圆心，同时也是多段线内接圆圆心

捕捉设置勾选垂足、切线，利用圆心、半径命令绘制多段线最大内接圆，OK！

ysq101

zdqwy19 发表于 2013-8-8 11:51
自己用手绘好了
选择一个多段线

内接圆直接绘三切园不是更快？？？

CadPLus

用偏移的方法总会出现这样的问题，因为有时总会遇上不能偏移的图形。
你能接受错误时不画圆，可以将现有程式作一子程式，
检测到出错或最后实体不是圆则退回跳过

牢固

利用VlaOffSet特性，计算最大圆

1. (vl-load-com)
   
2. (defun maxcircle (obj / ll ur ul lr a b c d clockwise loop lst cp)
   
3.   (vla-GetBoundingBox obj 'll 'ur)
   
4.   (setq  ll (vlax-safearray->list ll) ;_ 左下
   
5.   ur (vlax-safearray->list ur) ;_ 右上
   
6.   ul (list (car ll) (cadr ur) (caddr ll)) ;_ 左上
   
7.   lr (list (car ur) (cadr ll) (caddr ll)) ;_ 右下
   
8.   )
   
9.   (mapcar 'set
   
10.     '(a b c d)
    
11.     (mapcar '(lambda (x)
    
12.          (vlax-curve-getParamAtPoint
    
13.            obj
    
14.            (vlax-curve-getclosestpointto obj x)
    
15.          )
    
16.        )
    
17.       (list ll ul ur lr)
    
18.     )
    
19.   )
    
20.   (setq  clockwise (or (< a b c d)
    
21.           (< b c d a)
    
22.           (< c d a b)
    
23.           (< d a b c)
    
24.       )
    
25.   )
    
26.   (setq  d (min (- (car ur) (car ll))
    
27.          (- (cadr ur) (cadr ll))
    
28.     )
    
29.   )
    
30.   (if (not clockwise)
    
31.     (setq d (- d))
    
32.   )
    
33.   (setq d (* d 0.1))
    
34.   (setq  loop t
    
35.   objbak obj
    
36.   )
    
37.   (setq obj (vla-copy obj))
    
38.   (while loop
    
39.     (setq lst (VL-CATCH-ALL-APPLY 'vla-offset (list obj d)))
    
40.     (if  (not
    
41.     (VL-CATCH-ALL-ERROR-P lst)
    
42.   )
    
43.       (progn
    
44.   (vla-delete obj)
    
45.   (setq lst (vlax-safearray->list (vlax-variant-value lst)))
    
46.   (setq
    
47.     lst (vl-sort
    
48.     lst
    
49.     '(lambda (a b)
    
50.        (> (vlax-curve-getarea a) (vlax-curve-getarea b))
    
51.      )
    
52.         )
    
53.   )
    
54.   (setq obj (car lst)
    
55.         lst (cdr lst)
    
56.   )
    
57.   (mapcar 'vla-delete lst)
    
58.   (vla-GetBoundingBox obj 'll 'ur)
    
59.   (setq ll (vlax-safearray->list ll) ;_ 左下
    
60.         ur (vlax-safearray->list ur) ;_ 右上
    
61.   )
    
62.   (if (equal (vlax-curve-getarea obj) 1e-6)
    
63.     (progn
    
64.       (setq loop nil
    
65.       cp   (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))
    
66.       )
    
67.       (vla-delete obj)
    
68.     )
    
69.     (progn
    
70.       (setq d (min (- (car ur) (car ll))
    
71.        (- (cadr ur) (cadr ll))
    
72.         )
    
73.       )
    
74.       (if  (not clockwise)
    
75.         (setq d (- d))
    
76.       )
    
77.       (setq d (* d 0.1))
    
78. 
    
79.     )
    
80.   )
    
81.       )
    
82.       (progn
    
83.   (vla-GetBoundingBox obj 'll 'ur)
    
84.   (setq ll (vlax-safearray->list ll) ;_ 左下
    
85.         ur (vlax-safearray->list ur) ;_ 右上
    
86.   )
    
87.   (setq loop nil
    
88.         cp   (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))
    
89.   )
    
90.   (vla-delete obj)
    
91.       )
    
92.     )
    
93.   )
    
94.   (vla-addcircle
    
95.     (vla-get-ModelSpace
    
96.       (vla-get-ActiveDocument (vlax-get-acad-object))
    
97.     )
    
98.     (vlax-3d-point cp)
    
99.     (distance cp (vlax-curve-getclosestpointto objbak cp))
    
100.   )
     
101. )
     
102. ;;使用测试
     
103. (defun c:tt ()
     
104.   (setq ss (ssget '((0 . "*polyline"))))
     
105.   (repeat (setq n (sslength ss))
     
106.     (setq e (ssname ss (setq n (1- n))))
     
107.     (maxcircle (vlax-ename->vla-object e))
     
108.   )
     
109.   (princ)
     
110. )

(vl-load-com)<br /> (defun maxcircle (obj / ll ur ul lr a b c d clockwise loop lst cp)<br />   (vla-GetBoundingBox obj 'll 'ur)<br />   (setq  ll (vlax-safearray->list ll) ;_ 左下<br />   ur (vlax-safearray->list ur) ;_ 右上<br />   ul (list (car ll) (cadr ur) (caddr ll)) ;_ 左上<br />   lr (list (car ur) (cadr ll) (caddr ll)) ;_ 右下<br />   )<br />   (mapcar 'set<br />     '(a b c d)<br />     (mapcar '(lambda (x)<br />          (vlax-curve-getParamAtPoint<br />            obj<br />            (vlax-curve-getclosestpointto obj x)<br />          )<br />        )<br />       (list ll ul ur lr)<br />     )<br />   )<br />   (setq  clockwise (or (< a b c d)<br />           (< b c d a)<br />           (< c d a b)<br />           (< d a b c)<br />       )<br />   )<br />   (setq  d (min (- (car ur) (car ll))<br />          (- (cadr ur) (cadr ll))<br />     )<br />   )<br />   (if (not clockwise)<br />     (setq d (- d))<br />   )<br />   (setq d (* d 0.1))<br />   (setq  loop t<br />   objbak obj<br />   )<br />   (setq obj (vla-copy obj))<br />   (while loop<br />     (setq lst (VL-CATCH-ALL-APPLY 'vla-offset (list obj d)))<br />     (if  (not<br />     (VL-CATCH-ALL-ERROR-P lst)<br />   )<br />       (progn<br />   (vla-delete obj)<br />   (setq lst (vlax-safearray->list (vlax-variant-value lst)))<br />   (setq<br />     lst (vl-sort<br />     lst<br />     '(lambda (a b)<br />        (> (vlax-curve-getarea a) (vlax-curve-getarea b))<br />      )<br />         )<br />   )<br />   (setq obj (car lst)<br />         lst (cdr lst)<br />   )<br />   (mapcar 'vla-delete lst)<br />   (vla-GetBoundingBox obj 'll 'ur)<br />   (setq ll (vlax-safearray->list ll) ;_ 左下<br />         ur (vlax-safearray->list ur) ;_ 右上<br />   )<br />   (if (equal (vlax-curve-getarea obj) 1e-6)<br />     (progn<br />       (setq loop nil<br />       cp   (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))<br />       )<br />       (vla-delete obj)<br />     )<br />     (progn<br />       (setq d (min (- (car ur) (car ll))<br />        (- (cadr ur) (cadr ll))<br />         )<br />       )<br />       (if  (not clockwise)<br />         (setq d (- d))<br />       )<br />       (setq d (* d 0.1))<br /> <br />     )<br />   )<br />       )<br />       (progn<br />   (vla-GetBoundingBox obj 'll 'ur)<br />   (setq ll (vlax-safearray->list ll) ;_ 左下<br />         ur (vlax-safearray->list ur) ;_ 右上<br />   )<br />   (setq loop nil<br />         cp   (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))<br />   )<br />   (vla-delete obj)<br />       )<br />     )<br />   )<br />   (vla-addcircle<br />     (vla-get-ModelSpace<br />       (vla-get-ActiveDocument (vlax-get-acad-object))<br />     )<br />     (vlax-3d-point cp)<br />     (distance cp (vlax-curve-getclosestpointto objbak cp))<br />   )<br /> )<br /> ;;使用测试<br /> (defun c:tt ()<br />   (setq ss (ssget '((0 . "*polyline"))))<br />   (repeat (setq n (sslength ss))<br />     (setq e (ssname ss (setq n (1- n))))<br />     (maxcircle (vlax-ename->vla-object e))<br />   )<br />   (princ)<br /> )

zdqwy19

ysq101 发表于 2013-8-8 16:55
内接圆直接绘三切园不是更快？？？

三切圆和最大内接圆是有区别的

牢固

kcad2010 发表于 2013-8-8 19:02
牢固 大师 用的lisp试一下我发的dwg,中有一个画不出来,但是也会出现错误自动退出,,能让他不画圆但程式要自 ...

你提供的图我测试没有问题！