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