飞狐版主请进+《AutoCAD VBA开发精彩实例教程》问题
在《 VBA开发精彩实例》2004年1月第一版中，第3.8节的程序在执行时为什么总是提示“不支持的对象库功能”？？焦点锁定在If Not IsNull(ThisDrawing.SelectionSets.item("this")) Then
Set SSet = ThisDrawing.SelectionSets.item("this")
SSet.Delete
End If
的SSet=上，该如何解决？
不会大家都用不到这个吧？？
少了定义了吧
dim SSet as SelectionSets
是的，应该是定义为SelectionSets，源程序定义成了SelectionSet，以及第66行，也应该为Dim objUcs As AcadUCSs，源程序错误成Dim objUcs As AcadUCS。可是第89行开始：
Dim blkRef As AcadBlockReference
Dim element As AcadEntity
Set element = ThisDrawing.ModelSpace.item(ThisDrawing.ModelSpace.Count - 1)
If TypeOf element Is AcadBlockReference Then
Set blkRef = element
blkRef.Explode
blkRef.Delete
End If
又有问题，提示不支持的对象库功能，焦点锁定在blkRef =上，请问哪里还有问题啊～～
将AcadBlockReference更改为AcadBlock，能够运行，可是得不到结果……
这里是所有的代码，能不能帮我看看。
Option Explicit
Sub ExplodeText()
'输出WMF文件*****************************************
'选择文字
Dim objText As AcadText
Dim objMtext As AcadMText
Dim ptMin, ptMax '文字限制框的角点
Dim objEnt As AcadEntity
Dim pt As Variant
On Error Resume Next
Retry:
ThisDrawing.Utility.GetEntity objEnt, pt, "选择要分解的文字："
If Err0 Then '错误处理
Err.Clear
GoTo Retry
End If
'获得文字的限制框角点
If objEnt.ObjectName = "AcDbText" Then
Set objText = objEnt
objText.GetBoundingBox ptMin, ptMax
ElseIf objEnt.ObjectName = "AcDbMtext" Then
Set objMtext = objEnt
objMtext.GetBoundingBox ptMin, ptMax
Else
MsgBox "所选择的实体不是文字或者多行文字对象！", vbCritical
Exit Sub
End If
'为了提高分辨率，保证对象完全在当前视口中，进行缩放操作
ZoomWindow ptMin, ptMax
'ZoomScaled 0.9, acZoomScaledRelative
'创建选择集
Dim SSet As AcadSelectionSets
If Not IsNull(ThisDrawing.SelectionSets.item("this")) Then
Set SSet = ThisDrawing.SelectionSets.item("this")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("this")
Dim item(0) As AcadEntity
Set item(0) = objEnt
SSet.AddItems item
'输出WMF文件
ThisDrawing.Export "C:\temp", "WMF", SSet
'输入WMF文件*****************************************
'当前视口的高宽
Dim height As Double, width As Double '当前图形窗口的宽、高
height = ThisDrawing.GetVariable("ViewSize") '返回当前视口的高度（图形单位）
Dim dblScale As Variant '高宽比例
dblScale = ThisDrawing.GetVariable("ScreenSize") '该系统变量返回当前视口的像素单位（x和y值）
width = (dblScale(0) / dblScale(1)) * height
'视图中心点的绝对坐标
Dim ptCen, ptTemp
Dim ucsName As String
ucsName = ThisDrawing.GetVariable("UCSNAME") '该系统变量返回当前UCS的名称
If ucsName"" Then
Dim objUcs As AcadUCSs
Set objUcs = ThisDrawing.ActiveUCS
ptTemp = ThisDrawing.GetVariable("viewctr") '返回当前视口的中心点(UCS坐标)
ptCen = ThisDrawing.Utility.TranslateCoordinates(ptTemp, acUCS, acWorld, False)
ElseIf ucsName = "" Then
ptCen = ThisDrawing.GetVariable("viewctr")
End If
'视图左上角点的坐标（即WMF图形插入的基点）
Dim ptBase(0 To 2) As Double
ptBase(0) = ptCen(0) - width / 2: ptBase(1) = ptCen(1) + height / 2: ptCen(2) = 0
'输入文件
If Dir("C:\temp.wmf")"" Then '判断文件是否存在
ThisDrawing.Import "C:\temp.wmf", ptBase, 2
Kill ("c:\temp.wmf") '删除临时文件
Else
MsgBox "程序使用的临时文件不存在，请重新运行程序！", vbCritical
Exit Sub
End If
'分解得到的块参照************************************
Dim blkRef As AcadBlockReference
Dim element As AcadEntity
Set element = ThisDrawing.ModelSpace.item(ThisDrawing.ModelSpace.Count - 1)
If TypeOf element Is AcadBlockReference Then
Set blkRef = element
blkRef.Explode
blkRef.Delete
End If
objEnt.Delete '删除原来的文字对象
SSet.Delete
'缩放图形，返回原来的视图
ZoomPrevious
'ZoomPrevious
End Sub
有没有用过啊？？？ Sub ExplodeText()
'输出WMF文件*****************************************
'选择文字
Dim objText As AcadText
Dim objMtext As AcadMText
Dim ptMin, ptMax '文字限制框的角点
Dim objEnt As AcadEntity
Dim pt As Variant
On Error Resume Next
Retry:
ThisDrawing.Utility.GetEntity objEnt, pt, "选择要分解的文字："
If Err0 Then '错误处理
Err.Clear
Exit Sub
End If
'获得文字的限制框角点
If objEnt.ObjectName = "AcDbText" Then
Set objText = objEnt
objText.GetBoundingBox ptMin, ptMax
ElseIf objEnt.ObjectName = "AcDbMtext" Then
Set objMtext = objEnt
objMtext.GetBoundingBox ptMin, ptMax
Else
MsgBox "所选择的实体不是文字或者多行文字对象！", vbCritical
Exit Sub
End If
'为了提高分辨率，保证对象完全在当前视口中，进行缩放操作
ZoomWindow ptMin, ptMax
'ZoomScaled 0.9, acZoomScaledRelative
'创建选择集
Dim SSet As AcadSelectionSet
ThisDrawing.SelectionSets.item("this").Delete
Set SSet = ThisDrawing.SelectionSets.Add("this")
Dim item(0) As AcadEntity
Set item(0) = objEnt
SSet.AddItems item
'输出WMF文件
ThisDrawing.Export "d:\temp", "WMF", SSet
'输入WMF文件*****************************************
'当前视口的高宽
Dim height As Double, width As Double '当前图形窗口的宽、高
height = ThisDrawing.GetVariable("ViewSize") '返回当前视口的高度（图形单位）
Dim dblScale As Variant '高宽比例
dblScale = ThisDrawing.GetVariable("ScreenSize") '该系统变量返回当前视口的像素单位（x和y值）
width = (dblScale(0) / dblScale(1)) * height
'视图中心点的绝对坐标
Dim ptCen, ptTemp
Dim ucsName As String
ucsName = ThisDrawing.GetVariable("UCSNAME") '该系统变量返回当前UCS的名称
If ucsName"" Then
Dim objUcs As AcadUCSs
Set objUcs = ThisDrawing.ActiveUCS
ptTemp = ThisDrawing.GetVariable("viewctr") '返回当前视口的中心点(UCS坐标)
ptCen = ThisDrawing.Utility.TranslateCoordinates(ptTemp, acUCS, acWorld, False)
ElseIf ucsName = "" Then
ptCen = ThisDrawing.GetVariable("viewctr")
End If
'视图左上角点的坐标（即WMF图形插入的基点）
Dim ptBase(0 To 2) As Double
ptBase(0) = ptCen(0) - width / 2: ptBase(1) = ptCen(1) + height / 2: ptCen(2) = 0
'输入文件
If Dir("d:\temp.wmf")"" Then '判断文件是否存在
ThisDrawing.Import "d:\temp.wmf", ptBase, 2
Kill ("d:\temp.wmf") '删除临时文件
Else
MsgBox "程序使用的临时文件不存在，请重新运行程序！", vbCritical
Exit Sub
End If
'分解得到的块参照************************************
Dim blkRef As AcadBlockReference
Dim element As AcadEntity
Set element = ThisDrawing.ModelSpace.item(ThisDrawing.ModelSpace.Count - 1)
If TypeOf element Is AcadBlockReference Then
Set blkRef = element
blkRef.Explode
blkRef.Delete
End If
objEnt.Delete '删除原来的文字对象
SSet.Delete
'缩放图形，返回原来的视图
ZoomPrevious
'ZoomPrevious
End Sub
《AutoCAD VBA开发精彩实例教程》这本书哪里有买？ 书店应该都有的，要么就直接去规模大的书店找。
页:
[1]