通过选定整个目录中的图形文件插入到图形中的过程(zt)

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

通过选定整个目录中的图形文件插入到图形中的过程

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航