- 积分
- 1679
- 明经币
- 个
- 注册时间
- 2005-5-28
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
这是我从网上下载的一段代码“不需要打开文件可以把文件夹中的所有DWG插入到当前图形”,运行起来说 commondialog 没有定义,我该怎么解决,谢谢大家!
Sub IntBlkByDirDwg() On Error GoTo Err_Control Dim BlkFile As Variant Dim i As Integer Dim InstPnt As Variant Dim BlkRefObj As AcadBlockReference Dim varCancel As Variant
BlkFile = GetDir("选择要插入图形所在的目录:", "*.dwg")
If IsArray(BlkFile) Then ThisDrawing.Utility.Prompt vbCrLf & " 你选定了" & Str(UBound(BlkFile) + 1) & "个图形" For i = 0 To UBound(BlkFile) InstPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & " 请选择图形 " & JustFileName(BlkFile(i)) & " 的插入点:") Set BlkRefObj = ThisDrawing.ModelSpace.InsertBlock(InstPnt, _ BlkFile(i), 1#, 1#, 1#, 0#) Next
End If
Exit_Here: Exit Sub Err_Control: Select Case Err.Number Case -2147352567 varCancel = ThisDrawing.GetVariable("LASTPROMPT") If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then Err.Clear Resume Exit_Here Else Err.Clear Resume End If Case -2145320928 Err.Clear Resume Exit_Here Case Else Resume Exit_Here End Select
End Sub
'返回指定目录下指定名称所有文件的函数 Function GetFileListByPath(Path As String, FileName As String) As Variant
Dim s As String Dim sFiles() As String Dim i As Integer s = Dir(Path & FileName) If s <> "" Then ReDim sFiles(i) As String sFiles(i) = Path & s i = 1 s = Dir() While s <> "" ReDim Preserve sFiles(i) As String sFiles(i) = Path & s i = i + 1 s = Dir() Wend GetFileListByPath = sFiles End If
End Function
'选定目录的函数,使用了commonDialog类 Public Function GetDir(DialogTitle As String, FileName As String) As Variant
Dim dlg As CommonDialog 问题就出在这里
Dim Path As String Dim FileList As Variant
Set dlg = New CommonDialog dlg.DialogTitle = DialogTitle If dlg.Browse Then Path = dlg.Path If Path <> "" Then Path = Left$(Path, InStr(Path, vbNullChar) - 1) If Right$(Path, 1) <> "\" Then Path = Path & "\" FileList = GetFileListByPath(Path, "*.dwg") GetDir = FileList End If End If
End Function
'由文件全路径名称返回文件的函数 Public Function JustFileName(FileName) As String On Error Resume Next Dim count As Integer For count = Len(FileName) - 1 To 1 Step -1 If Mid(FileName, count, 1) = "\" Or Mid(FileName, count, 1) = "/" Then JustFileName = Right(FileName, Len(FileName) - count) Exit For End If Next End Function
|
|