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!!!
Beste Martijn,
Bedoel je zoiets ElOrPl of ElOrPl2(zie bijlage) en ElOrPl2(zie bijlage):
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.
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??
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
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 Suben om ellipsen juist niet te selecteren.
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 SubIs 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.
Deze twee programmaatjes werken wel ?? En het is echt een ellips.
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.
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
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
Beste TheChris,
Helpt dit:
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.
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.
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.
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