Selecteer alle objecten en wijzig de layernaam

[mvissche]

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

[HofCAD]

Beste Mvissche,

Heb je iets aan het bijgevoegde bestand ZetOpLaag.dvb in ZetOpLaag.zip.

Met vriendelijke groet, HofCAD CSI.

[mvissche]

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.

[HofCAD]

Beste Martin,

Dat de sub ZetOpLaag alleen de block referentie op een andere laag zet,
was te verwachten.
Je kan alleen de lagen van de subentiteiten aanpassen als je het blok opnieuw
definieerd, en dat automatisch laten gebeuren is niet makkelijk.
Waarom gebruik je het commando LAYTRANS niet?
http://blog.jtbworld.com/2007/05/translate-layers-using-laytrans-on.html

Code Selecteer Uitklappen


Sub Laytrans()
Dim StrFile As String
Dim StrFileAcad As String
'bit = 1: Force color to Bylayer
'bit = 2: Force linetype to Bylayer
'bit = 4: Translate into blocks
'bit = 8: Write the translation log file
StrFile = "C:\Standard.dws"
StrFileAcad = "C:\\Standard.dws"
ThisDrawing.Application.LoadArx ("Laytrans.arx")
If (Not Dir(StrFile) = "") Then
ThisDrawing.SendCommand "(acet-laytrans """ & StrFileAcad & """ (+ 1 2 4 8))" & vbCr
Else
ThisDrawing.Utility.Prompt "Warning: Bestand " & StrFile & " niet gevonden."
MsgBox "Bestand " & StrFile & " niet gevonden.", 16
End If
End Sub
In Lisp:

Code Selecteer Uitklappen

(Defun c:-Laytrans(/ File Path)
;bit = 1: Force color to Bylayer
;bit = 2: Force linetype to Bylayer
;bit = 4: Translate into blocks
;bit = 8: Write the translation log file
(setq File "Standard.dws")
(cond ((not (member "laytrans.arx" (arx))) (arxload "laytrans")))
(if (setq Path (findfile File))
(acet-laytrans Path (+ 1 2 4 8))
(progn
(princ (strcat "\nWarning: Bestand " File " niet gevonden."))
(alert (strcat "Bestand " File " niet gevonden."))
))
(princ)
)

Met vriendelijk groet, HofCAD CSI.

PS Zie ook http://discussion.autodesk.com/forums/thread.jspa?threadID=355802
http://discussion.autodesk.com/forums/thread.jspa?threadID=374312&tstart=7275

[mvissche]

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.

[HofCAD]

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.

Beste Martin,

Is het onderwerp '2 Layernamen samenvoegen naar 1 Layernaam'
http://www.cadsite.be/smf/index.php?topic=3518.0 en het
onderwerp 'Selecteer alle objecten en wijzig de layernaam'
slechts een probleem?

Als je de volgende lagen hebt:
DonaldDuck, DagobertDuck, GuusGeluk, KatrienDuck en WillieWortel
wil je dus bijv. dat je na de werking van het programma
het volgende aan lagen hebt:
DonaldDuck, DonaldEend, DagobertDuck, DagobertEend, GuusGeluk,
KatrienDuck, KatrienEend en WillieWortel.
Waarbij de lagen DonaldDuck, DagobertDuck en KatrienDuck leeg
zijn en de tekenobjecten(entiteiten) op de nieuwe lagen staan
DonaldEend, DagobertEend en KatrienEend en verder hun oude
eigenschappen hebben.


Als dit zo is en de omzetting regelmatig voorkomt.
Dan maak je eerst  eenmalig met het commando  LAYTRANS
een standards file (DWS) aan (let  op de Settings) bijv. Duck2Eend.dws
waarbij alle lagen met Duck in zich omgezet worden naar Eend.
In je programma  sla je eerst alle laagnamen met resp.
Color, Linetype en Lineweight op, waarna je de sub Laytrans
(waarschijnlijk met met bitcode 4 of 12)
zijn werking laat doen en daarna maak je met de sub NewLayX
de verdwenen lagen weer aan.

Is bovenstaande wat je wil bereiken?

Met vriendelijke groet, HofCAD CSI.

PS  Wat bedoel je met nieuwe kleur en bij dubbel foutmelding genereerd?

[mvissche]

Het is opgelost bedankt.

[oepske]

Ik werk ook met laytrans (autocad 2010, windows 7), maar slaag er niet in alle mappings in de dws file te bewaren. Bij het loaden van de dws file in een volgende tekening, worden een heel pak mappings "vergeten". Weet iemand wat hier fout loopt?