Zobrazit plnou verzi příspěvku: Výběrová množina přes VBA

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



Radek Pícha
07.03.2006, 16:50
Omlouvám se, zapoměl jsem napsat dotaz:
Jak lze přidat entitu oBlok do výběrové množiny oSS2?



Radek Pícha
14.03.2006, 13:36
Opravdu nikdo neví, jak pracovat s výběrovými množinami ve VBA?
Věděl by někdo, jak napsat filtr, aby se vytvořila výběrová množina bloků s určitým názvem?

Když v:
oSS.Select acSelectionSetAll, , , iFilterCode, vFilterValue
použiju:
vFilterValue(0) = "insert"
Vloží se do oSS všechny bloky.

Moc děkuji za odpověď.


Chop
17.03.2006, 08:19
Zkuste vyzkoušet:
Sub VybirejVesele()
Dim pomset As AcadSelectionSetDim FiltrTyp(0) As IntegerDim FiltrData(0) As Variant
For Each pomset In ThisDrawing.SelectionSets    If pomset.Name = "ss1" Then        pomset.Delete 'čistě pro jistotu, pokud po nějakém zhroucení ještě výběr ss1 existuje        Exit For    End IfNext pomset    Set pomset = ThisDrawing.SelectionSets.Add("ss1") 'čistý výběr        FiltrTyp(0) = 2 '<-dle DXF reference    FiltrData(0) = "RADEKROZ" 'možné hodnoty se řídí dle DXF reference (viz. Helpy)                                   pomset.SelectOnScreen FiltrTyp, FiltrData    End Sub

Radek Pícha
23.03.2006, 15:07
Velmi děkuji, stačilo nakopnout!
Nechápal jsem, co je "FilterCode". Příklad mi pomohl, již studuji skupinové kódy dxf z programátorské příručky.

Radek Pícha
23.03.2006, 15:49
A jak zadám součin filtrů? Například, když chci vybrat všechny bloky,
které se jmenují "RADEKROZ" a jsou vloženy v hladině "RAZITKO"?

    Set oSS = Application.ActiveDocument.SelectionSets.Add("Bloky")
    FiltrTyp(0) = 0

    FiltrData(0) = "insert"
    oSS.Select acSelectionSetAll, , , FiltrTyp, FiltrData 'všechny bloky

    Set oSS = Application.ActiveDocument.SelectionSets.Add("RADEKROZ")
    FiltrTyp(0) = 2

    FiltrData(0) = "RADEKROZ"
    oSS.Select acSelectionSetAll, , , FiltrTyp, FiltrData 'entity zvané "RADEKROZ"

    Set oSS = Application.ActiveDocument.SelectionSets.Add("RAZITKO")
    FiltrTyp(0) = 8

    FiltrData(0) = "RAZITKO"
    oSS.Select acSelectionSetAll, , , FiltrTyp, FiltrData 'entity v hladině "RAZITKO"

    Set oSS = Application.ActiveDocument.SelectionSets.Add("Bloky2")
    FiltrTyp(0) = ???
    FiltrData(0) = ???
    'všechny bloky "RADEKROZ" v hladině "RAZITKO"
    oSS.Select acSelectionSetAll, , , FiltrTyp, FiltrData



Chop
27.03.2006, 05:45
Samozřejmě podmínky lze libovolně kombinovat, ale k vyhodnocení musí dojít najednou. Pak to má vypadat takhle:
Dim FiltrTyp(2) as integer ' podle počtu podmínkových "dvojic" od 0 tj. 0,1,2…Dim FiltrData(2) as Variant
FiltrTyp(0)=0FiltrData(0) = "insert"FiltrTyp(1)=2FiltrData(1) = "RADEKROZ"FiltrTyp(2)=8FiltrData(2) = "RAZITKO"
oSS.Select acSelectionSetAll, , , FiltrTyp, FiltrData

Radek Pícha
28.03.2006, 13:30
Díky, funguje. Problém jsem měl právě v Dim ...(2)

Radek Pícha
30.03.2006, 09:59
Jak můžu procházet po jednotlivých entitách výběrové množiny?

Chop
30.03.2006, 10:58
Pokud máte z předchozích příkladů nadefinován výběr oSS, tak by to mělo fungovat takhle:
Dim oobj As ObjectFor Each oobj In oSS  MsgBox oobj.ObjectName 'takhle projdete všechny objekty ve výběru a zjistíte jejich typ a podle typu se rozhodnete, co dálNext oobj

Greenhorn
30.03.2006, 19:19
Zdravim,mam problem s určením mena entity resp. blokupre zistenie mena objektu použijemThisDrawing.Blocks.Item(i).Nametoto ide bez problemovproblem nastane keď chcem určiť meno entity pri výbere z množiny objektoucez ent = ThisDrawing.ModelSpace.Item(j)následne použijem meno = ent.NamePri použití .Name dostanem chybovú hlášku o tom že danýobjekt nepovoľuje túto možnosťMožno je problém vo verzii autocadu (používam Autocad 2002)Vie mi niekto poradiť ako určiť meno entity resp objektupri použití ModelSpace ?

Chop
31.03.2006, 06:55
Blok skutečně má svoje jméno a tak je možno je načíst.
Ve výběrové množině ale nemusí být jen bloky a objekt AcadEntity nebo AcadObject jméno (Name) tudíž nepodporuje.
Musíte procházet množinu po entitě, zjistit její Object.Name a podle toho pak zpracovat např. jen bloky a těm již Name přečíst lze.
Dim oobj As ObjectFor Each oobj In ThisDrawing.ModelSpace  MsgBox "Tato entita je typu: " & oobj.ObjectName    If oobj.ObjectName = "AcDbBlockReference" Then        Set blok = oobj        MsgBox "Jméno bloku je: " & blok.Name    End IfNext oobj

Greenhorn
06.04.2006, 08:26
Ešte Jedna otázočka,Autocad 2002 nepodporuje vlastnosť krivky "polyline.length"Potreboval by som zistiť dĺžku krivky bez rozloženia objektuna výkrese.Skúšal som rozložiť objekt pomocou .explode ale neviem prísťna spôsob určenia vlastnosti vráteného poľa objektou.

Chop
12.04.2006, 08:26
2002 již nemám, nemohu ověřit. Skutečně Vám nefunguje ani toto?
Dim oobj As ObjectDim bloktest As AcadLWPolylineFor Each oobj In ThisDrawing.ModelSpace  MsgBox "Tato entita je typu: " & oobj.ObjectName    If oobj.ObjectName = "AcDbPolyline" Then        Set bloktest = oobj        MsgBox "Délka křivky je: " & bloktest.Length    End IfNext oobj

Greenhorn
19.04.2006, 14:46
Ďakujem za odpoveď, medzičasom som problém vyriešil trochu iným spôsobomváš je o niečo elegantnejší tak keď bude trochu času vyskúšam.