一个CAD二次开发程序

haibinpro

从格式布局看，程序是很完美的，就是指出错处理。
大家re。

'把当前图纸中符合条件的圆替换为块(注：块在当前图纸中已存在)
[php]Public Sub ChangeEntity(ByVal MinRadius As Double, ByVal MaxRadius As Double, _
                ByVal BlockName As Variant, ByVal AutoSelect As
Boolean)
  On Error Resume Next
  
  Dim ssobject As AcadCircle
  Dim InsertionPoint(0 To 2) As Double
  Dim NewBlock As AcadBlockReference
  
  '创建选择集
  Dim ssetObj As AcadSelectionSet
  Set ssetObj = AcadDoc.SelectionSets("BlockCount")
  
  If Err.Number <> 0 Then
    Err.Clear
    Set ssetObj = AcadDoc.SelectionSets.Add("BlockCount")
  End If
  
  '清空选择集
  ssetObj.Clear
  
  '创建过滤机制
  Dim fType(0 To 6) As Integer
  Dim fData(0 To 6) As Variant
  
  fType(0) = 0: fData(0) = "Circle"
  
  fType(1) = -4: fData(1) = "<AND"
  fType(2) = -4: fData(2) = ">="
  fType(3) = 40: fData(3) = MinRadius
  fType(4) = -4: fData(4) = "<="
  fType(5) = 40: fData(5) = MaxRadius
  fType(6) = -4: fData(6) = "AND>"
  '选择符合条件的所有图元－圆
  If AutoSelect Then
    '自动选择方式
    ssetObj.Select acSelectionSetAll, , , fType, fData
  Else
    '提示用户选择
    ssetObj.SelectOnScreen fType, fData
  End If
  
  If ssetObj.Count = 0 Then Exit Sub
  
  '替换每一个圆为指定的块对象
  For Each ssobject In ssetObj
    InsertionPoint(0) = ssobject.Center(0)
    InsertionPoint(1) = ssobject.Center(1)
    InsertionPoint(2) = ssobject.Center(2)
   
    On Error GoTo ErrHandle
   
    Set NewBlock = AcadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName,
1, 1, 1, 0)
   
    ssobject.Delete
    Set NewBlock = Nothing
  Next
  
  '删除数组
  Erase fType: Erase fData
  
  '刷新视图
  'AcadDoc.Regen acActiveViewport
  
  MsgBox "当前图纸中有 " & ssetObj.Count & " 个符合条件的圆被替换为块 “" & BlockName & "”。",
vbInformation, "提示:"
  
  '删除选择集
  ssetObj.Clear
  ssetObj.Delete
  
  Set ssetObj = Nothing
  Exit Sub
ErrHandle:
  Select Case Err.Number
    Case -2147418113
        MsgBox "在当前图纸中找不到名称为: “" & BlockName & "” 的块参照,请确认块名！", vbCritical,
"错误:"
    Case Else
        MsgBox Err.Number & Chr(13) & Err.Description, vbCritical,
"产生了以下错误:"
  End Select
  Err.Clear
End Sub[/php]
版主提示：在代码中包含过滤条件and或or时，网页显示会有问题，最好使用php代码：）

zfguyan

容我慢慢研究一下
看别人的程序是件头痛的事
下次最好把你的思路简单介绍一下