Selectieset filteren Opgelost!!

martijn · vr 17 04 2009, 15:00:57

Hallo allemaal,

Frustrerend he, als iets het niet wil doen en je weet niet hoe het komt. Gelukkig bestaat dan dit forum vol met specialisten die je verder helpen.

Maar goed, ik heb het volgende probleem. Ik maak een selectieset op m'n scherm, maar hieruit moet alles gefilterd worden, behalve de polylijnen en de ovalen. Ik heb het programma werkende met een filter die alleen polylijnen doorlaat, maar zodra ik ga proberen om ook de ovalen er door te laten, krijg ik of een foutmelding of hij selecteerd niets meer.
Hieronder de code die werkt voor alleen polylijnen. kan iemand mij helpen met deze te verbouwen zodat er ook ovalen door de filter heen komen?

Dim ssetObj As AcadSelectionSet
Dim objgekozenSS As AcadObject

'Verwijderd de selectieset als de naam al bestaat
Call subverwijderSS

'Maakt nieuwe selectieset van alleen polylijnen en ovalen
Dim intFiltertype(0 To 0) As Integer
Dim varFilterdata(0 To 0) As Variant
intFiltertype(0) = 0
'intFiltertype(1) = 0
varFilterdata(0) = "LWPOLYLINE"
'varFilterdata(1) = "ELLIPSE"

Set ssetObj = ThisDrawing.SelectionSets.Add("selectie")
ssetObj.SelectOnScreen intFiltertype, varFilterdata
Set objgekozenSS = ssetObj.Item(0)

De dim intfiltertype en varfiltertype zet ik dan op (0 to 1)
en dit probeer ik dan ook in de 1na laaste regel. dit werkt helaas niet.
ook heb ik de laaste regel proberen aan te passen, maar ook hier kom ik niet uit.

Heluup!!!

HofCAD · ma 20 04 2009, 15:04:55

Beste Martijn,

Bedoel je zoiets ElOrPl of ElOrPl2(zie bijlage) en ElOrPl2(zie bijlage):

Code Selecteer

Sub ElOrPl()
   Dim ssetObj As AcadSelectionSet
   Dim FilterType(3) As Integer
   Dim FilterData(3) As Variant
   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add("ss")
   On Error GoTo 0
   Set ssetObj = ThisDrawing.SelectionSets("ss")
   ssetObj.Clear
   FilterType(0) = -4
   FilterData(0) = "<or"
   FilterType(1) = 0
   FilterData(1) = "ELLIPSE"
   FilterType(2) = 0
   FilterData(2) = "LWPOLYLINE"
   FilterType(3) = -4
   FilterData(3) = "or>"
   ssetObj.SelectOnScreen FilterType, FilterData
   MsgBox ("Selection set " & ssetObj.Name & " contains " & _
   ssetObj.Count & " items")
   ssetObj.Delete
   Set ssetObj = Nothing
End Sub

Met vriendelijke groet, HofCAD CSI.

martijn · di 21 04 2009, 11:53:39

Hoi Hofcad,

Weer bedankt voor je reactie, maar het zal wel aan mij liggen, maar als ik een ellips teken in acad kan ik deze gewoon nog selecteren. De gewone lijnen en cirkels en dergelijke worden wel goed gefilterd. Doe ik iets verkeerd??

HofCAD · di 21 04 2009, 12:49:18

Citaat van: martijn op di 21 04 2009, 11:53:39
Hoi Hofcad,

Weer bedankt voor je reactie, maar het zal wel aan mij liggen, maar als ik een ellips teken in acad kan ik deze gewoon nog selecteren. De gewone lijnen en cirkels en dergelijke worden wel goed gefilterd. Doe ik iets verkeerd??

Beste Martijn,

Geldt dat ook met mijn programma om ellipsen te selecteren

Code Selecteer

Sub SelEl()
   Dim sstext As AcadSelectionSet
   Dim FilterType(0) As Integer
   Dim FilterData(0) As Variant
   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add("ss")
   On Error GoTo 0
   Set ssetObj = ThisDrawing.SelectionSets("ss")
   ssetObj.Clear
   FilterType(0) = 0
   FilterData(0) = "ELLIPSE"
   ssetObj.Select acSelectionSetAll, , , FilterType, FilterData
   MsgBox ("Selection set " & ssetObj.Name & " contains " & _
   ssetObj.Count & " items")
   ssetObj.Delete
   Set ssetObj = Nothing
End Sub

en om ellipsen juist niet te selecteren.

Code Selecteer

Sub SelNoEl()
   Dim sstext As AcadSelectionSet
   Dim FilterType(2) As Integer
   Dim FilterData(2) As Variant
   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add("ss")
   On Error GoTo 0
   Set ssetObj = ThisDrawing.SelectionSets("ss")
   ssetObj.Clear
   FilterType(0) = -4
   FilterData(0) = "<Not"
   FilterType(1) = 0
   FilterData(1) = "ELLIPSE"
   FilterType(2) = -4
   FilterData(2) = "Not>"
   ssetObj.Select acSelectionSetAll, , , FilterType, FilterData
   MsgBox ("Selection set " & ssetObj.Name & " contains " & _
   ssetObj.Count & " items")
   ssetObj.Delete
   Set ssetObj = Nothing
End Sub

Is je ellips wel een Ellipse entiteit en geen Polyline entiteit,
m.a.w. als je de ellips tekent staat de AutoCAD variabele Pellipse
wel op 0.
Of je ellips een Ellipse entiteit of een Polyline entiteit is, kan je
natuurlijk controleren met het commando LIST of met PROPERTIES.

Met vriendelijke groet, HofCAD CSI.

martijn · di 21 04 2009, 13:18:58

Deze twee programmaatjes werken wel ?? En het is echt een ellips.

HofCAD · di 21 04 2009, 13:23:16

Citaat van: martijn op di 21 04 2009, 13:18:58
Deze twee programmaatjes werken wel ?? En het is echt een ellips.

Beste Martijn,

Mijn eerste twee programma's werken toch ook goed?
Dus ik snap eigenlijk niet goed, wat je probleem is.
Wil je Ellipsen en Polylijnen wel of niet in een selectieset?

Met vriendelijke groet, HofCAD CSI.

martijn · di 21 04 2009, 13:40:23

Sorry, je hebt gelijk. Ik heb n\het nogmaal geprobeerd en nu doet hij het wel goed?? Zal wel aan mij liggen. In ieder geval helemaal top. Ga het in m'n programmaatje verwerken.

Groetjes Martijn

TheChris · wo 22 04 2009, 14:56:01

Beste mensen,

Ik heb een soort zelfde probleem.
Ik ben bezig met een routine om attributen en teksten te selecteren.
Maar heb een probleem, wanneer er geen blocken en geen attrubuten zijn geselecteerd, maar wel tekst of teksten, wordt For each B In ssetObj eenmaal evengoed doorlopen. Kan iemand helpen.
Code:

Function SelectAttTekst(ByVal Teller As Integer) As Integer
Dim Ftype(0) As Integer, Fdata(0)
Dim grpcode(0 To 3) As Integer
Dim datavalue(0 To 3) As Variant
Dim B As AcadBlockReference
Dim T As AcadText
Dim attribuut As AcadAttributeReference
Dim ssetObj As AcadSelectionSet

grpcode(0) = -4: datavalue(0) = "<or" 'start or bock
grpcode(1) = 0: datavalue(1) = "Insert"
grpcode(2) = 0: datavalue(2) = "Text"
grpcode(3) = -4: datavalue(3) = "or>" 'Eind or block

Set ssetObj = ThisDrawing.SelectionSets.Add("ssetObj")

ssetObj.SelectOnScreen grpcode, datavalue ' Ftype, Fdata
MsgBox ssetObj.Count 'Aantal items in selectionset

For Each B In ssetObj
MsgBox "Bloknaam"
MsgBox B.Name ' Geef bloknaam weer
If B.HasAttributes Then attributen = B.GetAttributes
For i = LBound(attributen) To UBound(attributen)
MsgBox "Attrubuut gevonden"
Set attribuut = attributen(i)
MsgBox attribuut.TextString
Next i
Next B

For Each T In ssetObj
MsgBox "Tekst object gevonden"
MsgBox T.TextString
Next T

HofCAD · wo 22 04 2009, 18:41:48

Beste TheChris,

Helpt dit:

Code Selecteer

Sub SelectAttTekst2()
  Dim Ftype(0) As Integer, Fdata(0)
  Dim grpcode(0 To 3) As Integer
  Dim datavalue(0 To 3) As Variant
  Dim B As AcadBlockReference
  Dim T As AcadText
  Dim attribuut As AcadAttributeReference
  Dim ssetObj As AcadSelectionSet
  On Error Resume Next
  Set ssetObj = ThisDrawing.SelectionSets.Add("ss")
  On Error GoTo 0
  Set ssetObj = ThisDrawing.SelectionSets("ss")
  ssetObj.Clear
  grpcode(0) = -4: datavalue(0) = "<or" 'start or bock
  grpcode(1) = 0: datavalue(1) = "Insert"
  grpcode(2) = 0: datavalue(2) = "Text"
  grpcode(3) = -4: datavalue(3) = "or>" 'Eind or block
  ssetObj.SelectOnScreen grpcode, datavalue ' Ftype, Fdata
MsgBox ssetObj.Count 'Aantal items in selectionset
For i = 0 To ssetObj.Count - 1
      Set entObj = ssetObj.Item(i)
    If entObj.ObjectName = "AcDbBlockReference" Then
    MsgBox ("Blok reference object gevonden: " & entObj.Name)
       If entObj.HasAttributes Then attributen = entObj.GetAttributes
        For j = LBound(attributen) To UBound(attributen)
            MsgBox "Attrubuut gevonden"
            Set attribuut = attributen(j)
            MsgBox attribuut.TextString
        Next j
    Else: MsgBox ("Tekst object gevonden: " & entObj.TextString)
    End If
    Next i
End Sub

Met vriendelijke groet, HofCAD CSI.

TheChris · do 23 04 2009, 11:21:09

Beste HofCAD

Je hebt gelijk, ik was er ook achter gekomen, selectie code is:

For i = 0 To ssetObj.Count - 1
If VBA.LCase(ssetObj(i).ObjectName) = "acdbtext" Then
Set DataArray(Teller) = ssetObj(i)
Set DataArray(Teller) = ThisDrawing.HandleToObject(ssetObj(i).Handle)
Teller = Teller + 1
End If

If VBA.LCase(ssetObj(i).ObjectName) = "acdbblockreference" Then
If ssetObj(i).HasAttributes Then attributen = ssetObj(i).GetAttributes
For i2 = LBound(attributen) To UBound(attributen)
If Len(attributen(i).TextString) > 0 Then
Set DataArray(Teller) = attributen(i2)
Set DataArray(Teller) = ThisDrawing.HandleToObject(attributen(i2).Handle)
Teller = Teller + 1
End If
Next i2
End If
Next i

Evengoed bedankt.

HofCAD · do 23 04 2009, 14:18:51

Beste TheChris,

Welk voordeel heeft jouw code t.a.v. mijn code?
Ik snap de noodzaak van het gebruik van bijv. LCase, DataArray,
en Handle niet.

Met vriendelijke groet, HofCAD CSI.

TheChris · ma 27 04 2009, 09:21:16

Beste HofCad,

Geen voordeel heeft mijn code ten opzichte van de jouwe. Maar ik had dat er vangemaakt voor dat ik jouw antwoord las.
Ja die LCase, waarom niet en DataArray is een verzameling van de objecten om later makelijk te kunnen bewerken, en die handle ja is niet echt nodig idd.

gr chris