[编程交流] vba插入块在sc上指定

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function IsBlockExist(bName As String) As Boolean
  Dim oBlock As AcadBlock
  IsBlockExist = False
  For Each oBlock In ThisDrawing.Blocks
  If StrComp(oBlock.Name, bName, vbTextCompare) = 0 Then
  IsBlockExist = True
  End If
  Next
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function IsLayerExist(lName As String) As Boolean
  Dim oLayer As AcadLayer
  IsLayerExist = False
  For Each oLayer In ThisDrawing.Layers
  If StrComp(oLayer.Name, lName, vbTextCompare) = 0 Then
  IsLayerExist = True
  End If
  Next
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Sub InsertWithGhostImage()
    Dim blkName As String, layName As String
    Dim strPt As String, comStr As String
    blkName = InputBox(vbCrLf & "Block name to insert:", "Insert Block")
    If blkName = vbNullString Then Exit Sub
    If Not IsBlockExist(blkName) Then
    MsgBox "Block " & Chr(34) & blkName & Chr(34) & " does not exist"
    Exit Sub
    End If
    layName = InputBox(vbCrLf & "Layer name to insert block on:", "Insert Block", "0")
    If Not IsLayerExist(layName) Then
    MsgBox "Layer " & Chr(34) & layName & Chr(34) & " does not exist"
    Exit Sub
    End If
    With ThisDrawing
         On Error GoTo Err_Control
         .Utility.Prompt vbCrLf & "   Specify insertion point of block  >>"
         comStr = "(command " & _
                  Chr(34) & "._-insert" & Chr(34) & _
                  vbCr & Chr(34) & blkName & _
                  Chr(34) & " pause " & vbCr & _
                  Chr(34) & "1" & Chr(34) & _
                  vbCr & Chr(34) & "1" & Chr(34) & _
                  vbCr & Chr(34) & "0" & Chr(34) & ")"
                  .SendCommand comStr & vbCr
         DoEvents
         Dim oSpace As AcadBlock
         Dim oblkRef As AcadBlockReference
         If .ActiveSpace = acModelSpace Then
              Set oSpace = .ModelSpace
         Else
              Set oSpace = .PaperSpace
         End If
         Set oblkRef = oSpace.Item(oSpace.Count - 1)
    End With
Exit_Here:
    Exit Sub
Err_Control:
    MsgBox Err.Description
    Resume Exit_Here
End Sub

Your Code Here[/NOPARSE]

Your Code Here