边框问题

yingxunxue

' 绘边框的VBA程序
Public Sub test()
Dim ss As AcadSelectionSet
Dim i As AcadEntity
Dim pEntity(0) As AcadEntity
Set ss = ThisDrawing.ActiveSelectionSet
ss.Select acSelectionSetAll
ss(0).GetBoundingBox pmin, pmax
For Each i In ss
i.GetBoundingBox p1, p2
If p1(0) < pmin(0) Then pmin(0) = p1(0)
If p1(1) < pmin(1) Then pmin(1) = p1(1)
If p2(0) > pmax(0) Then pmax(0) = p2(0)
If p2(1) > pmax(1) Then pmax(1) = p2(1)
Next i
ThisDrawing.SendCommand "_.RECTANG " & pmin(0) & "," & pmin(1) & vbCr & pmax(0) & "," & pmax(1) & vbCr 把上面程序中的THISDRAWING替换为ACADDOC(在VB中使用) 为什么在Set ss = acaddoc.ActiveSelectionSet时出错"接口出错"

yingxunxue

错误信息


       

yingxunxue

可能是选择集的问题,我重新建立一个CAD文件,就可以运行一次.


有谁可以为我加个判断选择集的语句吗?


呵呵

david.xw

Dim ssetObj As AcadSelectionSet For Each ssetObj In ThisDrawing.SelectionSets
If ssetObj.Name = "SS" Then
ssetObj.Clear
ssetObj.Delete
Exit For
End If
Next ssetObj Set ssetObj = ThisDrawing.SelectionSets.Add("SS")

yingxunxue

<BR>       

2. 
   
3. ' 绘边框的VBA程序<BR>Public Sub test()<BR>Dim ss As AcadSelectionSet<BR>Dim i As AcadEntity<BR>Dim pEntity(0) As AcadEntity<BR>Dim ssetObj As AcadSelectionSet
5. 
   
6. For Each ssetObj In ThisDrawing.SelectionSets<BR>                         If ssetObj.Name = "SS" Then<BR>                                                         ssetObj.Clear<BR>                                                         ssetObj.Delete<BR>                                                         Exit For<BR>                         End If<BR>Next ssetObj
8. 
   
9. Set ssetObj = ThisDrawing.SelectionSets.Add("SS")
11. 
    
12. Set ss = ThisDrawing.ActiveSelectionSet<BR>ss.Select acSelectionSetAll<BR>ss(0).GetBoundingBox pmin, pmax<BR>For Each i In ss<BR>i.GetBoundingBox p1, p2<BR>If p1(0) &lt; pmin(0) Then pmin(0) = p1(0)<BR>If p1(1) &lt; pmin(1) Then pmin(1) = p1(1)<BR>If p2(0) &gt; pmax(0) Then pmax(0) = p2(0)<BR>If p2(1) &gt; pmax(1) Then pmax(1) = p2(1)<BR>Next i<BR>ThisDrawing.SendCommand "_.RECTANG " &amp; pmin(0) &amp; "," &amp; pmin(1) &amp; vbCr &amp; pmax(0) &amp; "," &amp; pmax(1) &amp; vbCr<BR>Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
14. 
    
15. 
    
16. 
    
17. 
    
18. Dim offsetObj As Variant<BR>offsetObj = pEntity(0).Offset(500)<BR>pEntity(0).Delete<BR>''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''<BR>pmax(0) = pmax(0) + 500<BR>pmin(1) = pmin(1) - 500<BR>Dim ucsobj As AcadUCS<BR>Dim origin As Variant<BR>Dim xAxispnt As Variant<BR>Dim yAxispnt As Variant<BR>Dim utilObj As Object<BR>Set utilObj = ThisDrawing.Utility<BR>'定义ucs<BR>utilObj.CreateTypedArray origin, vbDouble, pmax(0), pmin(1), 3<BR>utilObj.CreateTypedArray xAxispnt, vbDouble, pmax(0) + 1, pmin(1), 3<BR>utilObj.CreateTypedArray yAxispnt, vbDouble, pmax(0), pmin(1) + 1, 3<BR>Set ucsobj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxispnt, yAxispnt, "new_ucs")<BR>ThisDrawing.ActiveViewport.UCSIconAtOrigin = True<BR>        ThisDrawing.ActiveViewport.UCSIconOn = True<BR>         ThisDrawing.ActiveUCS = ucsobj
20. 
    
21. Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)<BR>Dim offsetObj1 As Variant<BR>offsetObj1 = pEntity(0).Offset(50)<BR>''''定义块的插入点<BR>Dim blockInspoint(0 To 2) As Double<BR>Dim blockRefobj As AcadBlockReference<BR>blockInspoint(0) = pmax(0)<BR>blockInspoint(1) = pmin(1)<BR>blockInspoint(2) = 3<BR>Set blockRefobj = ThisDrawing.ModelSpace.InsertBlock(inspoint, "F:\我的课题\陶瓷工业梭式窑CAD系统1\窑车标注1.dwg", 1, 1, 1, 0)

<br /> ' 绘边框的VBA程序<BR>Public Sub test()<BR>Dim ss As AcadSelectionSet<BR>Dim i As AcadEntity<BR>Dim pEntity(0) As AcadEntity<BR>Dim ssetObj As AcadSelectionSet <br /> For Each ssetObj In ThisDrawing.SelectionSets<BR>                         If ssetObj.Name = "SS" Then<BR>                                                         ssetObj.Clear<BR>                                                         ssetObj.Delete<BR>                                                         Exit For<BR>                         End If<BR>Next ssetObj <br /> Set ssetObj = ThisDrawing.SelectionSets.Add("SS") <br /> Set ss = ThisDrawing.ActiveSelectionSet<BR>ss.Select acSelectionSetAll<BR>ss(0).GetBoundingBox pmin, pmax<BR>For Each i In ss<BR>i.GetBoundingBox p1, p2<BR>If p1(0) &lt; pmin(0) Then pmin(0) = p1(0)<BR>If p1(1) &lt; pmin(1) Then pmin(1) = p1(1)<BR>If p2(0) &gt; pmax(0) Then pmax(0) = p2(0)<BR>If p2(1) &gt; pmax(1) Then pmax(1) = p2(1)<BR>Next i<BR>ThisDrawing.SendCommand "_.RECTANG " &amp; pmin(0) &amp; "," &amp; pmin(1) &amp; vbCr &amp; pmax(0) &amp; "," &amp; pmax(1) &amp; vbCr<BR>Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1) <br /> <br /> <br /> <br /> Dim offsetObj As Variant<BR>offsetObj = pEntity(0).Offset(500)<BR>pEntity(0).Delete<BR>''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''<BR>pmax(0) = pmax(0) + 500<BR>pmin(1) = pmin(1) - 500<BR>Dim ucsobj As AcadUCS<BR>Dim origin As Variant<BR>Dim xAxispnt As Variant<BR>Dim yAxispnt As Variant<BR>Dim utilObj As Object<BR>Set utilObj = ThisDrawing.Utility<BR>'定义ucs<BR>utilObj.CreateTypedArray origin, vbDouble, pmax(0), pmin(1), 3<BR>utilObj.CreateTypedArray xAxispnt, vbDouble, pmax(0) + 1, pmin(1), 3<BR>utilObj.CreateTypedArray yAxispnt, vbDouble, pmax(0), pmin(1) + 1, 3<BR>Set ucsobj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxispnt, yAxispnt, "new_ucs")<BR>ThisDrawing.ActiveViewport.UCSIconAtOrigin = True<BR>        ThisDrawing.ActiveViewport.UCSIconOn = True<BR>         ThisDrawing.ActiveUCS = ucsobj <br /> Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)<BR>Dim offsetObj1 As Variant<BR>offsetObj1 = pEntity(0).Offset(50)<BR>''''定义块的插入点<BR>Dim blockInspoint(0 To 2) As Double<BR>Dim blockRefobj As AcadBlockReference<BR>blockInspoint(0) = pmax(0)<BR>blockInspoint(1) = pmin(1)<BR>blockInspoint(2) = 3<BR>Set blockRefobj = ThisDrawing.ModelSpace.InsertBlock(inspoint, "F:\我的课题\陶瓷工业梭式窑CAD系统1\窑车标注1.dwg", 1, 1, 1, 0)

还是出现上面的问题.

雪山飞狐_lzh

Set ss = ThisDrawing.ActiveSelectionSet去掉，后面的ss用ssetObj代替

david.xw

ss(1).GetBoundingBox pmin, pmax


当前无选择集,当然会出错!

yingxunxue

兄弟 :到底如何做呀.


我的程序是在 画好边框后,在内边框插上标题栏,


只能运行一次扫心了

david.xw

lzh741206发表于2004-6-17 16:15:00Set ss = ThisDrawing.ActiveSelectionSet去掉，后面的ss用ssobj代替

...... For Each ssetObj In ThisDrawing.SelectionSets
If ssetObj.Name = "SS" Then
ssetObj.Clear
ssetObj.Delete
Exit For
End If
Next ssetObj Set ssetObj = ThisDrawing.SelectionSets.Add("SS") ssetObj .Select acSelectionSetAll
ssetObj .GetBoundingBox pmin, pmax
For Each i In ssetObj
i.GetBoundingBox p1, p2
......

yingxunxue

ssetObj .GetBoundingBox pmin, pmax 必须改为ssetOjb(0) 不知道是什么原因,而且运行中在CAD命令行中出现"命令: 忽略块 窑车标注 的重复定义。" 呵呵这不知道是什么意思