Radek Pícha
07.03.2006, 06:41
Dobrý den,
potřebuji přidat entitu do výběrové množiny oSS2 a nedaří se mi to.
Vycházel jsem z lekcí na http://www.cadforum.cz/cadforum/tema.asp
Zde je moje procedura:
'pokusy s tvorbou sSS2 jsou za ' protože nefungují
'lze vytvořit filtr tak, že vybere bloky se jménem "RADEKROZ"?
Sub VyberRadkyKusovniku()
Dim oSS As AcadSelectionSet
'Dim oSS2 As AcadSelectionSet
Dim oBlok As AcadEntity
Dim iFilterCode(0) As Integer
Dim vFilterValue(0) As Variant
Dim i As Integer
Dim Dotaz As String
'Dim ssobjs As AcadEntity
'Errorhandler (vymaže případně již existující výběrovou množinu)
On Error Resume Next
Application.ActiveDocument.SelectionSets("Bloky").Delete
Application.ActiveDocument.SelectionSets("Radky").Delete
On Error GoTo 0
'vytvoř výběrovou množinu nazvanou "Bloky"
Set oSS = Application.ActiveDocument.SelectionSets.Add("Bloky")
'Set oSS2 = Application.ActiveDocument.SelectionSets.Add("Radky")
iFilterCode(0) = 0: vFilterValue(0) = "insert"
'oSS.SelectOnScreen iFilterCode, vFilterValue 'pouze vybrané bloky
oSS.Select acSelectionSetAll, , , iFilterCode, vFilterValue 'všechny bloky
i = 0
If oSS.Count Then
For Each oBlok In oSS 'zpracovat všechny entity výběrové množiny "Bloky"
&nbs p; With oBlok
&nbs p; If UCase(.Name) = "RADEKROZ" Then
&nbs p;
'oSS2.AddObject i, oBlok
&nbs p;
'Set ssobjs(i) = oBlok
&nbs p; i = i + 1
&nbs p; End If
&nbs p; End With
&nbs p; Next oBlok
&nbs p; 'oSS2.AddItems ssobjs
&nbs p;
Dotaz = MsgBox("Ve výkrese je " + Str(i) + " řádků rozpisky." + Chr(13)
+ _
&nbs p;
"Chceš je nyní exportovat?", 4)
&nbs p; If Dotaz = vbYes Then
&nbs p;
MsgBox "Ještě to nemám, nyní bych chtěl exportovat a vymazat bloky z
oSS2 ..."
&nbs p; End If
&nbs p; End If
End Sub
potřebuji přidat entitu do výběrové množiny oSS2 a nedaří se mi to.
Vycházel jsem z lekcí na http://www.cadforum.cz/cadforum/tema.asp
Zde je moje procedura:
'pokusy s tvorbou sSS2 jsou za ' protože nefungují
'lze vytvořit filtr tak, že vybere bloky se jménem "RADEKROZ"?
Sub VyberRadkyKusovniku()
Dim oSS As AcadSelectionSet
'Dim oSS2 As AcadSelectionSet
Dim oBlok As AcadEntity
Dim iFilterCode(0) As Integer
Dim vFilterValue(0) As Variant
Dim i As Integer
Dim Dotaz As String
'Dim ssobjs As AcadEntity
'Errorhandler (vymaže případně již existující výběrovou množinu)
On Error Resume Next
Application.ActiveDocument.SelectionSets("Bloky").Delete
Application.ActiveDocument.SelectionSets("Radky").Delete
On Error GoTo 0
'vytvoř výběrovou množinu nazvanou "Bloky"
Set oSS = Application.ActiveDocument.SelectionSets.Add("Bloky")
'Set oSS2 = Application.ActiveDocument.SelectionSets.Add("Radky")
iFilterCode(0) = 0: vFilterValue(0) = "insert"
'oSS.SelectOnScreen iFilterCode, vFilterValue 'pouze vybrané bloky
oSS.Select acSelectionSetAll, , , iFilterCode, vFilterValue 'všechny bloky
i = 0
If oSS.Count Then
For Each oBlok In oSS 'zpracovat všechny entity výběrové množiny "Bloky"
&nbs p; With oBlok
&nbs p; If UCase(.Name) = "RADEKROZ" Then
&nbs p;
'oSS2.AddObject i, oBlok
&nbs p;
'Set ssobjs(i) = oBlok
&nbs p; i = i + 1
&nbs p; End If
&nbs p; End With
&nbs p; Next oBlok
&nbs p; 'oSS2.AddItems ssobjs
&nbs p;
Dotaz = MsgBox("Ve výkrese je " + Str(i) + " řádků rozpisky." + Chr(13)
+ _
&nbs p;
"Chceš je nyní exportovat?", 4)
&nbs p; If Dotaz = vbYes Then
&nbs p;
MsgBox "Ještě to nemám, nyní bych chtěl exportovat a vymazat bloky z
oSS2 ..."
&nbs p; End If
&nbs p; End If
End Sub