CADsite forum

Ik probeer de layer van een attribute in een genest block te veranderen.
Iemand een idee hoe dit aan te pakken.
Ik lees op de volgende manier de attribute van een block uit.

    With ThisDrawing.Utility
      Set MyObjSS = ThisDrawing.SelectionSets.Add("SelectBlock")
      ' Alles selecteren
      MyObjSS.Select acSelectionSetAll
       
        'Blokken selecteren
        For Each MyoEnt In MyObjSS
           
           If TypeOf MyoEnt Is AcadBlockReference Then
             Set MyBlockRef = MyoEnt
             'Controle op Attributes
             
             myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
                   
                  '-----------------------------------
                  'Zet de attribute bylayer
                  myvaratt(i).color = bylayer
                 
                  myvaratt(i).Update 'Gegevens updaten
                  '-----------------------------------
               Next
           End If
        Next ' Each myoEnt
   End With

Geweldig bedankt voor de routines ze hebben mij prima geholpen. Alles werkt nu.

Het is opgelost bedankt.

Beste Hofcad CSI,
Bedankt voor de info.

Wat ik wil is het volgende:
De layernamen van alle objecten uitlezen ook in de blocken.
Ik test de layernaam op een stukje string wat in de naam moet voorkomen.
Indien de string in de naam voorkomt wil ik de layernaam van dat object renamen echter met behoud van de instellingen van de bestaande layer zoals color en linetype enz.

LayTrans bied hier geen oplossing voor, omdat de nieuwe layer ook nieuwe color e.d. krijgt, en indien dubbel een foutmelding genereerd.

Heb je een idee hoe ik het beste alle layernamen kan selecteren van de objecten? Ook de blocken?.

Alvast heel erg bedankt.

Martin.

Deze routine past inderdaad de lagen in de tekening aan, maar niet alle lagen.
Zo worden de lagen in een blok niet aangepast. Heb je hier een idee over?

Gr, Martin.

Ik wil zoeken op een stuk string in de layernamen en de layernamen die deze string inzich hebben renamen naar 1 nieuwe laagnaam.

Beste cadgenoten,

Weten jullie of het mogelijk is om twee layernamen samen te voegen tot 1 layernaam?

Alvast bedankt voor de moeite.

gr, Martin

Ik heb alle objecten geselecteerd in een selectie set.
Hoe kan ik nu de laagnaam van de objecten inlezen en aanpassen?
Ik heb deze code. Maar kan de eigenschappen van de laag niet opvragen of wijzigen.
Jullie zullen me heel erg helpen als iemad een oplossing heeft.


Dim objTekst As AcadLayer 'object
Dim SSLayer As AcadSelectionSet 'Selectionset object

Set SSLayer = ThisDrawing.SelectionSets.Add("SSLayer")
SSlayer.Select acSelectionSetAll

  For Each objLayer In SSlayer
     objlayer.Layer = laagnaam
  Next objlayer


  SSlayer.Erase 'verwijder alle items in de selectionset
  SSLayer.Delete 'Verwijder Selectionset

Ik heb de routine gedownload en gestart.
Dit is echter een manier van uitlezen. Ik kan de attributes wel uitlezen (zie boven).
Het probleem zit hem in het fijt dat ik 1  attribute niet los kan aanklikken, om vervolgens te editten en weer weg te schrijven.

Ik wil dit oplossen in VBA. Het moet toch ook zonder lisp kunnen?

Kan iemand mij vertellen hoe je in lisp een enkel attribuut selecteerd, wijzigd en weer terugschrijft.
Alvast bedankt

Bedankt voor het antwoord.
Het probleem met het opvragen van de coordinaten is dat dit niet overeen zal komen met het insertionpoint van de attribute omdat overal op de tekst geklikt kan worden.

Oke dat was mij bekend. ,
Wat ik wil is een routine in VBA maken die een attribute edit om er berekeningen op los te laten en weer terug te schrijven.
Wat mij niet lukt is middels selectonscreen een attribuut te selecteren. Het blok wordt geselecteerd. Zo weet ik nooit welke attribuut ik wil aanpassen.
Heb je nog meer tips

Groet, Martin

Op het scherm klik ik met de muis op een attribuut.
Wat ik nu wil is dit attribuut kunnen editten. Als ik de gegevens van het block opvraag krijg ik wel een lijst met attributes,maar weet niet welke ik geselecteerd heb. Weet hier iemand raad? Ik heb de volgende code.

Dim ssetObj As AcadSelectionSet
Dim grpcode(0 To 1) As Integer
Dim datavalue(0 To 1) As Variant
Dim b As AcadBlockReference 'Toegevoegd voor Att
Dim attribuut As AcadAttributeReference 'Toegevoegd voor Att

grpcode(1) = 0: datavalue(1) = "Insert"
Set ssetObj = ThisDrawing.SelectionSets.Add("AlleTeksten")
ssetObj.SelectOnScreen grpcode, datavalue

For Each b In ssetObj ' Haal attributen op
If b.HasAttributes Then attributen = b.GetAttributes
  For i = LBound(attributen) To UBound(attributen)
    Set attribuut = attributen(i)
   â€˜ ?????
  Next i
Next b

Ik heb Autocad 2000 menu's die werkten nog in 2005. Nu wil ik de menu's laden in 2008 en krijg alleen maar errors.
Zo werkt het commando flyout niet goed meer.
Iemand dit ook aan de hand gehad, of weet iemand een conversie tool hiervoor, of een oplossing.

Alvast bedankt.

Martin.