Option Explicit
Private Sub cmdClear_Click()
  Me.lstFile.Clear
End Sub
Private Sub cmdDelete_Click()
    If lstFile.ListCount >= 1 Then
        If lstFile.ListIndex = -1 Then
            MsgBox "请选择列表中的图形名称！", vbExclamation, Me.Caption
            Exit Sub
        End If
        lstFile.RemoveItem (lstFile.ListIndex)
    End If
End Sub
Private Sub cmdInsert_Click()
  Dim i As Integer
  Dim pntX(0 To 2) As Double
  With Me
    pntX(0) = 0#: pntX(1) = 0#: pntX(2) = 0#
    If .lstFile.ListCount = 0 Then Exit Sub
    .pbInsert.Value = 0
    .pbInsert.Max = .lstFile.ListCount
    For i = 0 To .lstFile.ListCount - 1
        .lstFile.ListIndex = i
        ThisDrawing.Application.ActiveDocument.ModelSpace.InsertBlock pntX, .lstFile.List(i), 1, 1, 1, 0
        .pbInsert.Value = .pbInsert.Value + 1
    Next i
    MsgBox "批量插入块完毕。", vbInformation, .Caption
    Unload Me
  End With
End Sub
Private Sub cmdOpen_Click()
    Dim i As Integer
    Dim Y As Integer
    Dim Z As Integer
    Dim fileNames() As String
    On Error GoTo errHandle
    With comDlg
        .CancelError = True
        .MaxFileSize = 32767
        .Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
        .DialogTitle = "选择图形文件"
        .filter = "图形文件(*.dwg)|*.dwg"
        .FileName = ""
        .ShowOpen
    End With
    comDlg.FileName = comDlg.FileName & Chr(0)
    Z = 1
    For i = 1 To Len(comDlg.FileName)
        i = InStr(Z, comDlg.FileName, Chr(0))
        If i = 0 Then Exit For
        ReDim Preserve fileNames(Y)
        fileNames(Y) = mID(comDlg.FileName, Z, i - Z)
        Z = i + 1
        Y = Y + 1
    Next i
    Dim count As Integer
    count = lstFile.ListCount
    If Y = 1 Then
        If Not HasItem(fileNames(Y - 1)) Then
            lstFile.AddItem fileNames(Y - 1), count
        End If
    Else
        For i = 1 To Y - 1
            If StrComp(Right$(fileNames(0), 1), "") = 0 Then
                fileNames(i) = fileNames(0) & fileNames(i)
            Else
                fileNames(i) = fileNames(0) & "" & fileNames(i)
            End If
            
            If Not HasItem(fileNames(i)) Then
                lstFile.AddItem fileNames(i), i - 1 + count
            End If
        Next i
    End If
errHandle:
End Sub
Private Sub lstFile_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  On Error Resume Next
  MsgBox lstFile.List(lstFile.ListIndex), vbInformation, Me.Caption
End Sub
Private Function HasItem(ByVal strDwgName As String) As Boolean
    HasItem = False
    Dim i As Integer
    For i = 0 To lstFile.ListCount - 1
        If StrComp(lstFile.List(i), strDwgName, vbTextCompare) = 0 Then
            HasItem = True
            Exit Function
        End If
    Next i