---

Hallo

Wir haben im Betrieb im Jahr 2001 ein VBA Programm im Autocad 2000 geschrieben.
Nun haben wir das Programm kpl. neu revisioniert, und mit dem Visual Basic 6 geschrieben, mit Anbindung an Autocad 2004. Alles funktioniert super, ausser dass wir bei der Vermassung nicht die richtigen Linienfarben- und Linienstärken angeben können.
Wenn wir vermassen, wird alles kmpl. weiss angezeigt, mit Linienstärke 0.5. Wir wollen aber grün, mit gelben Zahlen.

Wie geht das mit dem Autocad 2004?

(Über die Hilfefunktion konnten wir auch keine Hilfe bekommen :-)

Vielen Dank, und einen schönen Tag.

------------------
Willi Maschinenbau AG | Verpackungsautomaten und Zuführsysteme

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

---

Das it nun leider ein kleines Problem wenn man mit STB's arbeitet.
Auch ich finde es etwas komisch (nicht im Sinne von lustig), das man zwar mit Plotstilen arbeiten kann, nun aber nicht einmal allen Objekten die in der Bemaßung sind, diese auch zuweisen kann.
Ist nicht gerade logisch, oder?
Man kann Farben und Strichstärken zuweisen, aber keine Plotstile.

Darum eine Bitte an Autodesk:
WENN IHR SCHON ETWAS NEUES UND SINNVOLLES ERFINDET, DANN VERGESST DOCH NICHT AUF DIE BEMASSUNG!!!! ARBEITET IHR ETWA NICHT MIT DEN PROGRAMMEN!!!!

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

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

---

mit AutoCad 2000 ging es aber :-)

warum gehts bei AutoCad 2004 nicht mehr? Schaltjahr?

Mooinz

------------------
Hofag AG | Engineering & Systemlieferant | http://www.hofag.com | 

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

---

Man kann unter ACAD2000 den Hilfslinien einen anderen Plotstil zuweisen? Wenn ja, häng mir doch einen Bildschirmausdruck mit dem Fenster für die jeweilige Einstellung dran.

Man kann ihnen eine andere Acad-Farbe zuweisen, sowie eine eigene Strichstärke, aber du wirst es nicht schaffen ihnen einen Plotstil und damit eine andere Plotfarbe zuzuweisen. Wenn du mit CTB's arbeitest, kein Problem, dann kannst du natürlich mit unterschiedlichen Farben ausplotten, wenn du allerdings mit STB's arbeitest, dann haben die Hilfslinien und der Text immer die gleiche Farbe wie die Bemaßung, unabhängig von den Farben die du ihnen zugewiesen hast.
Aber wie schon gesagt, ich lasse mich gerne eines besseren belehren.

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

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

---

Hallo WilliAG,
nachdem ich deinen Beitrag noch einmal gelesen habe, dürfte dein Problem doch nicht an den STB's liegen.
Hier ein Lösungsansatz.

Code:

---

Public Sub AssignNewDimstyle()
    Dim pDimStyles As AcadDimStyles
    Dim pNewDimStyle As AcadDimStyle
   
    Set pDimStyles = ThisDrawing.DimStyles
    ' deine Bemaßung z.B. "Standard" aktiv setzen
    On Error Resume Next
    Set pNewDimStyle = pDimStyles.Item("Standard")
    If Err Then
        Err.Clear
        Set pNewDimStyle = pDimStyles.Add("Standard")
    End If
    ThisDrawing.ActiveDimStyle = pNewDimStyle
    ' ändere deine Variablen
    ThisDrawing.SetVariable "_DIMCLRD", 3                'Farbe der Maßlinien und Maßpfeile - grün
    ThisDrawing.SetVariable "_DIMCLRE", 3                'Farbe der Hilfslinien - grün
    ThisDrawing.SetVariable "_DIMCLRT", 2                'Farbe des Maßtexts - gelb (byblock wäre 256)
    ThisDrawing.SetVariable "_DIMLWD", "18"              'Legt die Maßlinienstärke fest
    ThisDrawing.SetVariable "_DIMLWE", "18"              'Weist Hilfslinien eine Linienstärke zu
    ' kopiere sie in deinen Stil
    pNewDimStyle.CopyFrom ThisDrawing
    ' setzt deinen Bemaßungsstil aktiv
    ThisDrawing.ActiveDimStyle = pNewDimStyle

End Sub

---

Fehler mußt du natürlich noch abfangen, ich hab die Funktion auch noch nicht getestet, hoffe sie funktioniert aber.

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

[Diese Nachricht wurde von RoSiNiNo am 06. November 2003 editiert.]

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

---

Hallo Roland

Wollte auch gerade schreiben: Uns gehts da nicht um Plotstyles, sondern dass die Farben im Modellbereich und auch die Linienstärken stimmen. Dann sollte es schon gut rauskommen :-)

Ich teste mal den Code, und werde mich mal wieder melden!

Vielen Dank für die Hilfe!

Willi Maschinenbau AG

------------------
Willi Maschinenbau AG | Verpackungsautomaten und Zuführsysteme

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

---

Hm...

Ich habe es auspobiert, aht aber nicht funktioniert. Ich denke, es ligt dran, dass wir aus einem normalen VB6-Programm auf AutoCad zugreiffen (eigenständiges Programm mit EXE).

hmhmhm.....
Weisst du nicht wie es aus dem VB6 geht? Ansonsten geht echt alles gut.

unser Programm sieht so aus:

'Berechnungsprozedur für Querschnitt W18-W46

'Deklarationen Koordinaten des Füllrohrumrisses
Dim points(0 To 15) As Double
Dim PX1 As Double
Dim PY1 As Double
Dim PX2 As Double
Dim PY2 As Double
Dim PX3 As Double
Dim PY3 As Double
Dim PX4 As Double
Dim PY4 As Double
Dim PX5 As Double
Dim PY5 As Double
Dim PX6 As Double
Dim PY6 As Double
Dim PX7 As Double
Dim PY7 As Double
Dim PX8 As Double
Dim PY8 As Double

'Deklarationen für Werte-Eingabe
Dim abc1 As Double
Dim abc2 As Double
Dim abc3 As Double
Dim abc4 As Double
Dim abc5 As Double
Dim abc6 As Double
Dim ff As Double

'Deklarationen für Füllrohr-Zeichnen und Vermassung
Dim dimObj As Object
Dim point1(0 To 2) As Double, point2(0 To 2) As Double
Dim location(0 To 2) As Double
Dim offsetObj As Variant
Dim layer As Object
Dim B As Double
Dim A As Double
Dim C As Double
Dim U As Double
Dim Z As Double
Dim P As Double
Dim D As Double
Dim R As Double
Dim L As Double
Dim Q As Double

Dim fbreal As Double 'Wert der als Folienbreite Angegeben wird, und FB in Maschine
Dim fbrech As Double 'Wert der aus reeler Folienbreite erstellt wird, um zu rechnen
Dim fueb As Double 'gesamter Überstand der an Innenmasse additiert wird
Dim EingabeOk As Boolean

Private Sub cmdback_Click()
Unload Me
frmStart.Show
End Sub

Private Sub cmdhelp_Click()
frmHilfe.Show
End Sub

Private Sub cmdspezi_Click()
spezifi.Show
End Sub

Private Sub cmdend_Click()
If MsgBox("Programm beenden ?", vbQuestion + vbOKCancel, "Beenden") = vbOK Then
    End
End If
End Sub

'Zeichnet der Querschnitt, und setzt die Vermassung

Private Sub cmdzeich_Click()

'Zeichnet Füllrohr-Umriss
Set plineObj = AcadDoc.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True

'Versetzt Füllrohr-Umriss um XYmm nach Aussen
offsetObj = plineObj.Offset(TextBox13.Text)

'Vermassung E-Mass
point1(0) = (PX1): point1(1) = (PY7): point1(2) = 0
point2(0) = (PX1): point2(1) = (PY1): point2(2) = 0
location(0) = -12: location(1) = PY1 + (abc5 / 2): location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Vermassung B-Mass
point1(0) = (PX5): point1(1) = (PY5): point1(2) = 0
point2(0) = (PX6): point2(1) = (PY5): point2(2) = 0
location(0) = (abc2 / 2) + PX6: location(1) = PY5 + 12: location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Vermasung A-Mass
point1(0) = (PX5): point1(1) = (PY5): point1(2) = 0
point2(0) = (PX3): point2(1) = 0: point2(2) = 0
location(0) = (PX4) + 12: location(1) = (PY4): location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Vermassung G-Mass
point1(0) = (PX8): point1(1) = (PY4): point1(2) = 0
point2(0) = (PX4): point2(1) = (PY4): point2(2) = 0
location(0) = abc6 / 2: location(1) = 0 - 12: location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Vermassung D-Mass
point1(0) = (PX7): point1(1) = (PY7): point1(2) = 0
point2(0) = (PX6): point2(1) = (PY6): point2(2) = 0
location(0) = -P: location(1) = P + A + (PY7): location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Vermassung C-Mass
point1(0) = (PX4): point1(1) = (PY4): point1(2) = 0
point2(0) = (PX5): point2(1) = (PY5): point2(2) = 0
location(0) = (PX3) + R + L: location(1) = (PY4) + R + L: location(2) = 0
Set dimObj = AcadDoc.ModelSpace.AddDimAligned(point1, point2, location)

'Regenerieren und Zoom-Alles
AcadDoc.Regen acAllViewports
AcadDoc.Application.ZoomExtents

Set layer = AcadDoc.Layers.Add("AM_0") 'Layer festlegen
AcadDoc.ActiveLayer = layer

cmdzeich.Enabled = False
MsgBox ("Das Füllrohr wurde gezeichnet! Bitte Bemassung kontrollieren!")

End Sub

Private Sub cmdschulter40_Click()
frmForm40.Show
frmForm40.Height = 3570
End Sub

'Berechnet der Querschnitt und die Vermassung

Private Sub cmdberech_Click()
   
If Not IsNumeric(TextBox2.Text) Or Not IsNumeric(TextBox3.Text) _
Or Not IsNumeric(TextBox12.Text) Or Not IsNumeric(TextBox13.Text) Then
    Beep
    MsgBox "Alle Eingaben müssen Zahlen sein", vbExclamation, "Fehler"
    Exit Sub
End If

If foluebstand.Text = "" Then foluebstand.Text = 0 'Startwert 0 falls keine Anforderung an Überstand

'Berechnungen des FS-Umriss
'--->Eingabe
fbreal = TextBox12.Text 'Wert der reelen Folienbreite
abc1 = TextBox3.Text 'A-Mass
abc2 = TextBox2.Text 'B-Mass

'--->Ausgabe
fueb = 54
fbrech = fbreal - (foluebstand.Text * 2)
abc3 = abc1 / Sqr(2) 'C-Mass
abc4 = (fbrech - (2 * abc3) - (2 * abc2) - fueb - abc1) / (2 - Sqr(2)) 'D-Mass
abc5 = abc1 - (abc4 * Sqr(2)) 'E-Mass
abc6 = (abc4 / Sqr(2)) + abc2 + (abc3 / Sqr(2)) 'G-Mass

'Koordinaten für Füllrohr-Umriss
PX1 = 0
PY1 = (abc4 / Sqr(2))
PX2 = (abc4 / Sqr(2))
PY2 = 0
PX3 = (abc4 / Sqr(2)) + abc2
PY3 = 0
PX4 = abc6
PY4 = abc1 / 2
PX5 = (abc4 / Sqr(2)) + abc2
PY5 = abc1
PX6 = (abc4 / Sqr(2))
PY6 = abc1
PX7 = 0
PY7 = abc5 + (abc4 / Sqr(2))
PX8 = 0
PY8 = (abc4 / Sqr(2))

'Setzt Pünkte an Koordinaten für den Anfang der Polylinie; Umriss Füllrohr
points(0) = PX1: points(1) = PY1
points(2) = PX2: points(3) = PY2
points(4) = PX3: points(5) = PY3
points(6) = PX4: points(7) = PY4
points(8) = PX5: points(9) = PY5
points(10) = PX6: points(11) = PY6
points(12) = PX7: points(13) = PY7
points(14) = PX8: points(15) = PY8
   
' Ergebnisse anzeigen
Labelc.Caption = Format(abc3, "####.00")
Labeld.Caption = Format(abc4, "####.00")
Labele.Caption = Format(abc5, "####.00")
Labelg.Caption = Format(abc6, "####.00")
Label39.Caption = Format(TextBox12.Text / 2, "####.00")

' Negative Ergebnisse werden rot dargestellt
EingabeOk = True

If Sgn(abc3) = -1 Then
    Labelc.ForeColor = &HFF
    EingabeOk = False
Else
    Labelc.ForeColor = &H8000000D
End If

If Sgn(abc4) = -1 Then
    Labeld.ForeColor = &HFF
    EingabeOk = False
Else
    Labeld.ForeColor = &H8000000D
End If

If Sgn(abc5) = -1 Then
    Labele.ForeColor = &HFF
    EingabeOk = False
Else
    Labele.ForeColor = &H8000000D
End If

If Sgn(abc6) = -1 Then
    Labelg.ForeColor = &HFF
    EingabeOk = False
Else
    Labelg.ForeColor = &H8000000D
End If

' Zeichnen-Taste nur freigeben, wenn ACAD installiert ist und
' Ergebnisse ok sind.
If AcadInst = True And EingabeOk = True Then
    cmdzeich.Enabled = True
Else
    cmdzeich.Enabled = False
End If
 
'Variablen für die korrekte Positionierung der Vermassung (nach Aussen, nicht nach Innen)
B = abc4
A = B / Sqr(2)
C = A
U = B / 2
Z = 12 - U
P = Z / Sqr(2)
D = abc3
Q = D / 2
R = Q / Sqr(2)
L = 12 / Sqr(2)

End Sub

Private Sub foluebstand_Enter()
TextBox13.SelStart = 0
TextBox13.SelLength = TextBox13.MaxLength
cmdzeich.Enabled = False
End Sub

Private Sub TextBox12_Enter()
TextBox12.SelStart = 0
TextBox12.SelLength = TextBox12.MaxLength
cmdzeich.Enabled = False
End Sub

Private Sub TextBox12_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Nur Ziffern 0..9 und BackSpace erlaubt
If InStr("0123456789." + Chr(8), Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox13_Enter()
TextBox13.SelStart = 0
TextBox13.SelLength = TextBox13.MaxLength
cmdzeich.Enabled = False
End Sub

Private Sub TextBox13_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Nur Ziffern 0..9 und BackSpace erlaubt
If InStr("0123456789." + Chr(8), Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox2_Enter()
TextBox2.SelStart = 0
TextBox2.SelLength = TextBox2.MaxLength
cmdzeich.Enabled = False
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Nur Ziffern 0..9 und BackSpace erlaubt
If InStr("0123456789" + Chr(8), Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox3_Enter()
TextBox3.SelStart = 0
TextBox3.SelLength = TextBox3.MaxLength
cmdzeich.Enabled = False
End Sub

------------------
Willi Maschinenbau AG | Verpackungsautomaten und Zuführsysteme

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

---

Du erstellst zwar Bemaßungen aber keinen Bemaßungsstil.
Du solltest vorher einen Bemaßungsstil erzeugen und aktiv setzen, sonst nimmt das Programm ja den gerade aktiven Bemaßungsstil.
Wie du Bemaßungsstile definierst, s.o.

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

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

---

Hallo

Wenn ich aber dein Programm integriere, erkennt er die Deklarationen nicht. Er erkennt gar nichts. Wie stellt man es im VB6 so ein, dass man auf die VBA vom Autocad zugreiffen kann?
Wenn ich nur mit VBA arbeiten würde, würde es sicherlich funtionieren.

Danke für die Hilfe

------------------
Willi Maschinenbau AG | Verpackungsautomaten und Zuführsysteme

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