VBA怎样删除重复的圆？

taqqug · 发表于 2010-1-23 17:30:13

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

弱弱的问一下大家，CAD中怎样用VBA标记出有重复的圆，并提示删掉？我现在用选择集选择了所有的圆，想用圆心相等来判断（还得半径相等），可是圆心不让比较，请大家帮忙，最好给出代码，谢谢啦！！

sealive_leafage · 发表于 2010-1-23 21:19:09

本帖最后由 sealive_leafage 于 2010-1-23 21:21 编辑

circle对象的center属性返回的是一维三元素数组，0代表圆心的x坐标，1代表圆心的y坐标，2代表圆心的z坐标，可以分别通过比较x、y、z坐标判断圆心是否相同，注意控制坐标值的对比位数；
circle对象的center属性示例代码如下：
Sub Example_Center()
Dim circObj As AcadCircle
Dim currCenterPt(0 To 2) As Double
Dim newCenterPt(0 To 2) As Double
Dim radius As Double
' Define the initial center point and radius for the circle
currCenterPt(0) = 20: currCenterPt(1) = 30: currCenterPt(2) = 0
radius = 3
' Create the circle in model space
Set circObj = ThisDrawing.ModelSpace.AddCircle(currCenterPt, radius)
ZoomAll
MsgBox "The center point of the circle is " & currCenterPt(0) & ", " & currCenterPt(1) & ", " & currCenterPt(2),vbInformation, "Center Example"
' Change the center point of the circle
newCenterPt(0) = 25: newCenterPt(1) = 25: newCenterPt(2) = 0
circObj.center = newCenterPt
circObj.Update
' Query the results of the new center position
' Notice the output from the center property is a variant
Dim centerPoint As Variant
centerPoint = circObj.center
MsgBox "The center point of the circle is " & centerPoint(0) & ", " & centerPoint(1) & ", " & centerPoint(2),vbInformation, "Center Example"
End Sub

woaishuijia · 发表于 2010-1-23 22:03:55

圆心(点)是数组,得分别比较三个坐标才行.

' X- l! }1 m& E1 \8 j0 q; x# r
Dim SS As AcadSelectionSet, FT(0) As Integer, FD(0) As Variant, C1 As AcadCircle, C2 As AcadCircle, I As Long, J As Long& J8 N6 O! s* w+ S
FT(0) = 0: FD(0) = "Circle"
/ _* o2 M9 l) m) } R
Set SS = ThisDrawing.SelectionSets.Add("SS")+ |5 N1 n7 B+ \( y9 m/ \; ^
SS.Select acSelectionSetAll, , , FT, FD
7 ~0 _4 T1 M+ O( N# ?! v1 Z3 f
If SS.Count > 1 Then
8 G# G- H: Q! C/ Q. m2 Q4 D1 C
For I = SS.Count - 1 To 1 Step -1
& w2 ^" E7 }* A E1 j+ u8 @
Set C1 = SS.Item(I)
3 W9 \- G+ b& L1 o
For J = I - 1 To 0 Step -1+ ~* L, [! g- e
Set C2 = SS.Item(J): ]' S4 B# m" C* M. ]# f; N& y3 ?3 y
If C1.Center(0) = C2.Center(0) And C1.Center(1) = C2.Center(1) And C1.Center(2) = C2.Center(2) And C1.Radius = C2.Radius Then
! M$ t# K3 T& Z$ ?; A1 {% C G( {$ m
C1.Delete
2 s3 _" F' k' q! V
Exit For
" ]0 b7 H0 R7 z
End If& G1 A9 {/ }& {% x4 O }& R7 @
Next* m. w( E, p q" @5 }
Next, p! x7 n" p6 l$ f/ |! N4 q" ^
End If6 J, @. g# o# G: c* E5 [
SS.Delete
) E9 _$ L5 ]# N- p, r# e+ a! \0 t, a8 T

复制代码

taqqug · 发表于 2010-1-25 23:17:13

豁然开朗，我知道我错哪了，谢谢大家了！

cone521 · 发表于 2010-7-13 14:52:44

我也在学习中，谢谢楼主

3duser · 发表于 2010-10-4 20:33:16

如果好了的话楼主将怎样删除线的命令一起研发下吧

www1974 · 发表于 2010-10-4 22:08:42

如果好了的话楼主将怎样删除线的命令一起研发下吧: \( M& @5 ]; z& K9 M8 Q
3duser 发表于 2010-10-4 20:33 http://www.3dportal.cn/discuz/images/common/back.gif

安装ET工具，输入overkill即可

bc1008 · 发表于 2010-10-9 16:15:38

提示: 作者被禁止或删除内容自动屏蔽

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

通知

[已解决] VBA怎样删除重复的圆？

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

浏览过的版块

bc1008 bc1008 当前离线积分 -49 UID 1324067 主题在线时间小时注册时间 2010-10-8 头像被屏蔽	发表于 2010-10-9 16:15:38 \| 显示全部楼层来自：中国上海提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对举报