---

Hallo Zusammen!

Ich habe in meiner Template Zeichnung festgelegte Bemaßungsstile (BS) und entsprechende Layer (LA).
(BS) BEM1_1 / (LA) BEM1_1
(BS) BEM1_10 / (LA) BEM1_10
usw.

Ich möchte mir unter VBA ein Tool erstellen, welches dann über ^C^C-vbarun BEM.dvb!... aus den normalen Werkzeugmakros wie:
_dimlinear
_dimaligned
_dimradius
etc.

vor dem jeweiligen Bemaßungsbefehl, im Hintergrund erkennt, welcher Bemaßungsstil gerade aktuel geschaltet ist und daraufhin den entsprechenden Layer aktuel schaltet.

Könnte man dieses über It...Then oder Select Case möglich machen?

Wäre schön, wenn mir dabei jemand helfen würde.

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja, das kannst du, brauchts ja nur zu schaun welcher Dimstyle gerade aktuell ist und einfach den jeweiligen Layer aktuell setzten. Aber das hast du ja sowieso schon richtig angedacht.
Auf den Button legst du dann einfach die Funktion vor den Dim -Befehlen.  den Rest kannst du sicher einfach selber schreiben.

------------------
Roland

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Roland!

Danke für die Antwort.
Rein theoretisch hab ich mein Tool schon fertig!
Leider praktisch noch nicht!

Ich hab einfach das Problem den richtigen Faden zufinden.
Wäre schön, wenn Du mir da auf die Sprünge helfen könntest.

Wie müßte der Code in einem Modul lauten?

Ich habe es mal so versucht:

Mein VBA Modul lautet Bem01.dvb.

Das Werkzeugkastenmakro lautet:
^C^C-vbarun Bem01.dvb!Modul1.Bem;^C^C_dimlinear

VBA Code Modul1:
Sub BEM()

Dim BEM1_1 As AcadDimStyle
Dim BEM1_10 As AcadDimStyle
Dim Standard As AcadDimStyle

Dim BEM_1_1 As AcadLayer
Dim BEM_1_10 As AcadLayer
Dim BEM As AcadLayer

If ThisDrawing.ActiveDimStyle = BEM1_1 Then
    ThisDrawing.ActiveLayer = BEM_1_1
ElseIf ThisDrawing.ActiveDimStyle = BEM1_10 Then
    ThisDrawing.ActiveLayer = BEM_1_10
ElseIf ThisDrawing.ActiveDimStyle = Standard Then
    ThisDrawing.ActiveLayer = BEM
End If

End Sub

Leider komme ich da nicht weiter, so gehts nicht!

Wie gesagt, für Hilfe wäre ich sehr dankbar.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

So kann es auch nicht funktionieren, sag ich mal.
Probier es einmal damit:

Code:

---

select case ThisDrawing.ActiveDimStyle.Name
    case "BEM1_1"
        'Mach etwas
    case "BEM1_10"
        'Mach etwas anderes
    case else
end select

---

------------------
Roland

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen!

Geht doch!!!
Man darf nur nicht vorzeitig aufgeben.

So ruf ich vor dem Befehl "_dimlinear" ein VBA Makro auf, welches erkennt, welcher DimStyle gerade aktiv ist und schaltet den entsprechenden Layer ein.

Werkzeugkastenmakro:
^C^C-vbarun Bemstyle.dvb!Modul1.Bem ^C^C_dimlinear

VBA Makro (Modul):
Sub Bem()

Dim ActDimStyle As AcadDimStyle

Set ActDimStyle = ThisDrawing.ActiveDimStyle
   
Select Case ActDimStyle.Name
Case "BEM1_1"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_1")
Case "BEM1_1_Ausgerichtet"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_1_Ausgerichtet")
Case "BEM1_10"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_10")
Case "BEM1_100"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_100")
Case "BEM1_2"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_2")
Case "BEM1_2_Ausgerichtet"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_2_Ausgerichtet")
Case "BEM1_20"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_20")
Case "BEM1_50"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_50")
End Select

End Sub

Vieleicht hilfts dem einen oder anderen ja?

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen!

Hat hierzu evtl. jemand einen eleganteren oder anderen Vorschlag.

Code:

---

Dim ActDimStyle As AcadDimStyle

Set ActDimStyle = ThisDrawing.ActiveDimStyle
   
Select Case ActDimStyle.Name
Case "BEM1_1"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_1")
Case "BEM1_1_Ausgerichtet"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_1_Ausgerichtet")
Case "BEM1_10"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_10")
Case "BEM1_100"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_100")
Case "BEM1_2"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_2")
Case "BEM1_2_Ausgerichtet"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_2_Ausgerichtet")
Case "BEM1_20"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_20")
Case "BEM1_50"
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("BEM1_50")
End Select

End Sub

---

Ferner die Frage.
Kennt jemand ein Tool, mit dem man einen Bogen (Bogenlänge) wie bei der linearen Bemaßung bemaßen kann, oder könnte man soetwas auch mit VBA lösen?

Ich arbeite mit ACAD 2004.

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Zu der Bogenbemassung: Suche mal nach dem Lisp Dimarc.lsp. Unter VBA könntest du eine Winkelbemaasung erstellen und den Bemassungswert mit dem Längenwert des Bogens überschreiben.

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

wenn der name des Bemassungsstils und des Layers immer gleich sind dann gehts auch mit einem Einzeiler:

Code:

---

ThisDrawing.ActiveLayer = ThisDrawing.Layers(ActDimStyle.Name)

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi!

Vielen Dank für die Infos.
Das mit dem dimarc.lisp funktioniert gut.

Wert mal versuchen dieses in VBA umzusetzen bzw. Deine Idee, Carsten, zu testen.

Das mit der anderen Geschichte test ich auch mal, Stelli.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP