Hallo Leute,
habt Ihr schon mal ein Rohr gezeichnet? Erst Mittelinie, dann Mittellinie um den Betrag D/2 nach unten und nach oben kopieren, die beiden äußeren Kanten in Volllinien ändern, usw.
Aber es geht auch leichter! Womit? Na, mit nem Macro natürlich. Rohr zeichnen von Punkt „a“ nach „b“ inklusive Layereinstellungen. Irgendwann war ichs mal wieder leid mit der Kopiererei. „Macro muß her!“ Drei Linien, dürfte ja nicht so schwer sein. Was ist mit der Wandstärke?
Mhm, also 5 Linien. Nennweite? Nach DIN!
Und wenn`s den Abstand nicht gibt? Also Manuelle Eingabe ermöglichen.
3 Linien! Könnte auch ein Durchgangsloch darstellen oder einen Behälter?
5 Linien! Gewindeloch??, oder Behälter mit Wandstärke?
Gedacht und programmiert.
Am Ende sind die Zeilen für die Barmenue und das Macro.
Das Macro besteht aus 2 Dateien,
1. „Rohr.bas“ und
2. Datei „DIN336-1-param.dat“.
Beide Dateien im Verzeichnis ...\MicroMacro\Allgemein abspeichern. Im Rohr.bas müsst Ihr noch bei “ ' hier die Layer anpassen“ halt Eure Layergruppen anpassen. Bei „pfad“ Euren Pfad eingeben.
Syntax für die Zeilen in der Barmenue aus Teil 2:
Bauteile
{
Rohre (Seitenansicht), "macro rohre.bas"
}
---------------------------------------------
hier beginn das „Rohr.bas“ Macro
'Rohre, Durchgangsbohrungen und Gewindebohrungen zeichnen
'
'erstellt von rwcaddy
'
' letzte Revision 09.2002
'---------------------------------------------------------------
' Public filepos&
Public DN_t as String
Public DN_n as Integer ' Index Durchmesser
Public snw_x as Integer ' Index NW-Schraube
'---------------------------------------------------------------
Sub zeichne(a#,startpoint As MbePoint, endpoint As MbePoint, ansicht as Integer)
Dim point1 As MbePoint, point2 As MbePoint
Dim point3 as MbePoint, point4 as MbePoint
deltax# = a#/sqr((endPoint.x - startPoint.x)^2# + (endPoint.y - startPoint.y)^2#)*(endPoint.y-startPoint.y)
deltay# = a#/sqr((endPoint.x - startPoint.x)^2# + (endPoint.y - startPoint.y)^2#)*(endPoint.x-startPoint.x)
point1.x = startPoint.x + deltax#
point1.y = startpoint.y - deltay#
point2.x = endPoint.x + deltax#
point2.y = endpoint.y - deltay#
point3.x = startPoint.x -deltax#
point3.y = startpoint.y + deltay#
point4.x = endPoint.x - deltax#
point4.y = endpoint.y + deltay#
MbeSendCommand "PLACE SMARTLINE"
MbeSendDataPoint point1, ansicht
MbeSendDataPoint point2, ansicht
MbeSendReset
MbeSendCommand "PLACE SMARTLINE"
MbeSendDataPoint point3, ansicht
MbeSendDataPoint point4, ansicht
MbeSendReset
End Sub
'=====+++++++++++++++++++==============++++++++++++++++++=============
Sub VOREINST(activeLevel#, activeColor%, activeWeight%, activeStyle%)
' mit voreingestellter Linie ZEICHNEn
' Level zurücksetzen
MbeSettings.level = activeLevel
MbeSettings.color = activeColor
MbeSettings.weight = activeWeight
MbeSettings.lineStyle = activeStyle
End Sub
'=====+++++++++++++++++++==============++++++++++++++++++=============
Sub MITTELL(activeLevel#)
fileNa$ = MbeDgnInfo.dgnFileName
k% = InStr (fileNa$,"Projekt_1",1)
b% = InStr (fileNa$,"Projekt_2",1)
' weder Projekt_1 noch Projekt_2 dann Projekt_1
If((k=0) or (b=0)) Then b=1
' MITTELLinien einsetzen
' Projekt_1-Einstellungen
If b <> 0 Then
Select Case activeLevel ' MITTELLinien Level einstellen
' hier die Layer anpassen
case 11 To 15
MbeSettings.level = 11
case 16 To 20
MbeSettings.level = 16
case 21 To 25
MbeSettings.level = 21
case 26 To 30
MbeSettings.level = 26
case 31 To 35
MbeSettings.level = 31
case 36 To 40
MbeSettings.level = 36
End Select
MbeSettings.color = 3 ' Farbe setzen
MbeSettings.weight = 0 ' Setzen der Strichstärke
MbeSettings.lineStyle = 4 ' Setzen der Strichart Strichpunktlinie
ElseIf k <> 0 Then
' Projekt_2-Einstellungen
Select Case activeLevel ' MITTELLinien Level einstellen
' hier die Layer anpassen
case 9 To 12
MbeSettings.level = 9
MbeSettings.color = 7
case 17 To 20
MbeSettings.level = 17
MbeSettings.color = 7
case 25 To 32
MbeSettings.level = 26
MbeSettings.color = 2
case 33 To 36
MbeSettings.level = 33
MbeSettings.color = 6
case 37 To 40
MbeSettings.level = 37
MbeSettings.color = 5
End Select
MbeSettings.weight = 0
MbeSettings.lineStyle = 4
End If
End Sub
'=====+++++++++++++++++++==============++++++++++++++++++=============
Sub VERDECKT(activeLevel#)
fileNa$ = MbeDgnInfo.dgnFileName
fileNa$ = MbeDgnInfo.dgnFileName
k% = InStr (fileNa$,"Projekt_1",1)
b% = InStr (fileNa$,"Projekt_2",1)
' weder Projekt_1 noch Projekt_2 dann Projekt_1
If((k=0) or (b=0)) Then b=1
' VERDECKTe Linien ZEICHNEn
' Projekt_1-Einstellungen
If b <> 0 Then
Select Case activeLevel ' VERDECKT Level einstellen
' hier die Layer anpassen
case 11 To 15
MbeSettings.level = 13
case 16 To 20
MbeSettings.level = 18
case 21 To 25
MbeSettings.level = 23
case 26 To 30
MbeSettings.level = 28
case 31 To 35
MbeSettings.level = 33
case 36 To 40
MbeSettings.level = 38
End Select
MbeSettings.color = 2 ' Farbe setzen
MbeSettings.weight = 0 ' Setzen der Strichstärke
MbeSettings.lineStyle = 3 ' Setzen der Strichart unsichtbare
ElseIf k <> 0 Then
' Projekt_2-Einstellungen
Select Case activeLevel ' VERDECKT Level einstellen
' hier die Layer anpassen
case 9 To 12
MbeSettings.level = 9
MbeSettings.color = 7
case 17 To 20
MbeSettings.level = 17
MbeSettings.color = 1
case 25 To 32
MbeSettings.level = 27
MbeSettings.color = 2
case 33 To 36
MbeSettings.level = 33
MbeSettings.color = 6
case 37 To 40
MbeSettings.level = 37
MbeSettings.color = 5
End Select
MbeSettings.weight = 0
MbeSettings.lineStyle = 3
End If
End Sub
'==========================================================================
Sub main
Dim startPoint As MbePoint
Dim endPoint As MbePoint
Dim point1 As MbePoint, point2 As MbePoint
Dim point3 as MbePoint, point4 as MbePoint
Dim saveMessages%
Dim activeColor%, activeWeight%, activeStyle%, activeStyleName$, activeLevel#
Dim ansicht as Integer
Dim a#, x%, y%, deltax#, deltay#, z%, n%
z% = 26
n% = 2
dim t$(6), nw$(z) ' Variablen nd... für Gewinde
dim dn#(z), wd#(z,n)
Dim nd$(19) ' Nenndurmesser Gewinde
Dim ngg# ' Durmesser Gewinde
Dim ndk# ' Kernloch
Dim ndf# ' Durchgangsloch Durchmesser fein
Dim ndm# ' Durchgangsloch Durchmesser mittel
Dim ndg# ' Durchgangsloch Durchmesser grob
Dim vn$, an$, vnn$, ann$
Dim filepos as long
Dim elem as New MbeElement
filepos = MbeDgnInfo.endOfFile
'---------------------------------------------------------------
Dim pfad$
' pfad = "c:\Bentley\MicroMacro\Allgemein\"
pfad = "C:\WIN32APP\MicroMacro\Allgemein\"
MbeSendReset
'---------------------------------------------------------------
' Turn off all messages except those written by this macro
' Sichern der aktiven Einstellungen die in diesem Macro geändert werden
activeColor = MbeSettings.color
activeWeight = MbeSettings.weight
activeStyle = MbeSettings.lineStyle
activeLevel = MbeSettings.level
' Möglichkeit des Aufrufes mit Parameterübergabe von außen
CMD$ = Command$
If (InStr(CMD, "/DBS")) <> 0 Then
Y=5
t1=4
GoTo Weiter1
End If
If (InStr(CMD, "/Gewinde")) <> 0 Then
Y=6
t1=5
GoTo Weiter1
End If
' Abfrage welches Rohr
t$(0) = "Rohr DIN2448 / DIN2458 "
t$(1) = "Rohr variabler Durchmesser"
t$(2) = "Rohr DIN2448 mit Wandstärke "
t$(3) = "Rohr DIN2458 mit Wandstärke "
t$(4) = "Rohr mit variablem Durchmesser und Wandstärke n"
t$(5) = "Durchgangs Bohrung für Schrauben"
t$(6) = "Gewinde Bohrungen"
y = MbeSelectBox("Bitte auswählen",t$(),"Auswahl Rohr")
If y% =-1 Then Goto Ende
Weiter1:
n = 0
If snw_x% = 0 Then snw_x = 10
'Übergabe Index Durchmesser an x
x = DN_n
Select case y
case 0, 2, 3
'---------------------------------------------------------------
' Nennweiten
nw$(1) = "DN 010"
nw$(2) = "DN 015"
nw$(3) = "DN 020"
nw$(4) = "DN 025"
nw$(5) = "DN 032"
nw$(6) = "DN 040"
nw$(7) = "DN 050"
nw$(8) = "DN 065"
nw$(9) = "DN 080"
nw$(10) = "DN 100"
nw$(11) = "DN 125"
nw$(12) = "DN 150"
nw$(13) = "DN 175"
nw$(14) = "DN 200"
nw$(15) = "DN 250"
nw$(16) = "DN 300"
nw$(17) = "DN 350"
nw$(18) = "DN 400"
nw$(19) = "DN 450"
nw$(20) = "DN 500"
nw$(21) = "DN 600"
nw$(22) = "DN 700"
nw$(23) = "DN 800"
nw$(24) = "DN 900"
nw$(25) = "DN 1000"
nw$(26) = "DN 1200"
DN_t = nw(x)
'---------------------------------------------------------------
' Durchmesser
dn#(1) = 17.2
dn#(2) = 21.3
dn#(3) = 26.9
dn#(4) = 33.7
dn#(5) = 42.4
dn#(6) = 48.3
dn#(7) = 60.3
dn#(8) = 76.1
dn#(9) = 88.9
dn#(10) = 114.3
dn#(11) = 139.7
dn#(12) = 168.3
dn#(13) = 193.7
dn#(14) = 219.1
dn#(15) = 273.0
dn#(16) = 323.9
dn#(17) = 355.6
dn#(18) = 406.4
dn#(19) = 457.0
dn#(20) = 508.0
dn#(21) = 610.0
dn#(22) = 711.0
dn#(23) = 813.0
dn#(24) = 914.0
dn#(25) = 1016.0
dn#(26) = 1220.0
'---------------------------------------------------------------
' Wandstärken
wd#(1,1) = 1.5
wd#(1,2) = 1.5
wd#(2,1) = 2.0
wd#(2,2) = 2.0
wd#(3,1) = 2.3
wd#(3,2) = 2.0
wd#(4,1) = 2.6
wd#(4,2) = 2.0
wd#(5,1) = 2.6
wd#(5,2) = 2.0
wd#(6,1) = 2.6
wd#(6,2) = 2.3
wd#(7,1) = 2.9
wd#(7,2) = 2.3
wd#(8,1) = 2.9
wd#(8,2) = 2.6
wd#(9,1) = 3.2
wd#(9,2) = 2.9
wd#(10,1) = 3.6
wd#(10,2) = 3.2
wd#(11,1) = 4.0
wd#(11,2) = 3.6
wd#(12,1) = 4.5
wd#(12,2) = 4.0
wd#(13,1) = 4.5
wd#(13,2) = 4.0
wd#(14,1) = 6.3
wd#(14,2) = 4.5
wd#(15,1) = 6.3
wd#(15,2) = 5.0
wd#(16,1) = 7.1
wd#(16,2) = 5.6
wd#(17,1) = 8.0
wd#(17,2) = 5.6
wd#(18,1) = 8.8
wd#(18,2) = 6.3
' Eingabe der Nennweite
x = MbeSelectBox("Bitte Nennweite auswählen",nw$(),"Auswahl Nennweiten")
If x% =-1 Then Goto Ende
case 1
' Eingabe der variablen Nennweite
If vnn$ = "" Then vn$="100"
vn$ = MbeInputBox("Bitte Nennweite eingeben",vnn$,"variable Nennweite")
If vn$ = "" Then Goto Ende
x = 1
dn#(x)= Val(vn$)
vnn$ = vn$
case 4
' Eingabe der variablen Nennweite und variabler Wandstärke
If vnn$ = "" Then vnn$="100"
If ann$ = "" Then ann$="3.2"
vn$ = MbeInputBox("Bitte Nennweite eingeben",vnn$,"variable Nennweite")
If vn$ = "" Then Goto Ende
x = 1
dn#(x)= Val(vn$)
vnn$ = vn$
an$ = MbeInputBox("Bitte Wandstärke eingeben",ann$,"variable Wandstärke")
If an$ = "" Then Goto Ende
x = 1
n = 1
wd#(x,n)=Val(an$)
ann$ = an$
case 5, 6
' Gewinde-Nenn-Durchmesser und
' Durchmesser fuer Durchgangslöcher nach DIN ISO 273 fein, mittel. grob
nd$(1) = "M 2"
nd$(2) = "M 2.5"
nd$(3) = "M 3"
nd$(4) = "M 3.5"
nd$(5) = "M 4"
nd$(6) = "M 5"
nd$(7) = "M 6"
nd$(8) = "M 8"
nd$(9) = "M10"
nd$(10) = "M12"
nd$(11) = "M16"
nd$(12) = "M20"
nd$(13) = "M22"
nd$(14) = "M24"
nd$(15) = "M27"
nd$(15) = "M30"
nd$(17) = "M33"
nd$(18) = "M36"
nd$(19) = "M39"
x = snw_x
' Eingabe des Nenndurchmessers
x = MbeSelectBox( "Bitte Nenn-Durchmesser eingeben ",nd$(),"Auswahl M")
If x% =-1 Then Goto Ende
'-------------- Parameter-Datei öffnen, Datensätze auslesen und mit Eingabe vergleichen
DateiName$ = pfad+"DIN336-1-param.dat"
z = FileLen(DateiName$)
If z > 0 Then
OPEN DateiName$ For Input Access Read Shared As #1
Do While Not Eof(1)
Input #1, D_T$, ngg#, ndk#, ndf#, ndm#, ndg#
If nd$(x) = D_T$ Then Exit DO ' wenn M (Gewinde) gefunden schleife verlassen
LOOP
Else
MbeMessageBox ("Datei nicht gefunden!")
Exit Sub
End If
Close #1
If nd$(x) = D_T$ Then
GOTO Weiter
Else
MbeMessageBox "Daten für Gewinde "+nd$(x) +" nicht gefunden!!"
GoTo Ende
End If
Weiter:
If y% = 5 Then dn#(x) = ndm# ' Wert für Durchgangsloch
If y% = 6 Then ' Werte für Gewinde Durchgangsloch
dn#(x) = ndk#
n = 1
wd#(x,n)= ngg#
End If
End Select
' MbeMessageBox Str$(dn#(x)) + " "+ Str$(wd#(x,n))
' Mittellinien einsetzen
Call MITTELL (activeLevel) ' MITTELLinien
MbeSendCommand "PLACE SMARTLINE"
' Eingabeaufforderung an den User, Datenpunkt setzen
MbeWritePrompt "Eingeabe Datenpunkt"
MbeGetInput MBE_DataPointInput, MBE_CommandInput
If MbeState.inputType = MBE_DataPointInput Then
If MbeState.getInputDataPoint (startPoint, ansicht) = MBE_Success Then
status = MbeState.getInputDataPoint (startPoint, ansicht)
End If
End If
MbeSendDataPoint startpoint, ansicht
' Eingabeaufforderung an den User, Datenpunkt setzen
MbeWriteCommand "Plaziere den Endpunkt der Linie"
MbeWritePrompt "Eingeabe Datenpunkt"
MbeGetInput MBE_DataPointInput, MBE_CommandInput
If MbeState.inputType = MBE_DataPointInput Then
If MbeState.getInputDataPoint (endPoint, ansicht) = MBE_Success Then
status = MbeState.getInputDataPoint (endPoint, ansicht)
End If
End If
MbeSendDataPoint endpoint, ansicht
MbeSendReset
Select case y
case 2, 3, 4, 6
If wd#(x,n) > 0.99 Then ' niedrigste Grenze für Wandstärke
' Verdeckt einsetzen für Innendurchmesser
Call VERDECKT (activeLevel) ' VERDECKT, gestrichelt
If y% = 6 Then
a# = wd#(x,n)/2.0
Else
a# = (dn#(x)-2*wd#(x,n))/2.0
End If
' MbeMessageBox " Innendurchmesser " + Str$(a#)
zeichne a#, startpoint, endpoint, ansicht
End If
End Select
' Berechnung von x und y für den Außendurchmesser
' Level zurücksetzen
MbeSettings.color = activeColor
MbeSettings.weight = activeWeight
MbeSettings.lineStyle = activeStyle
MbeSettings.level = activeLevel
a# = dn#(x)/2.0
' MbeMessageBox " Aussendurchmesser " + Str$(a#)
zeichne a#, startpoint, endpoint, ansicht
MbeSendReset
Ende:
' Level zurücksetzen
MbeSettings.color = activeColor
MbeSettings.weight = activeWeight
MbeSettings.lineStyle = activeStyle
MbeSettings.level = activeLevel
MbeSendReset
MbeSendReset
MbeSendCommand "choose element"
End Sub
'Syntax für Rohr mit Richtungsangabe
'gewuenschte Länge angeben L=
'P1- anfangpunkt vom Rohr'
'P2- Punkt als Richtung
'P3- Endpunkt vom Rohr
'Var=((x2-x1)^2+(y2-y1)^2)^(1/2)
'x3=L/Var*(x2-x1)
'y3=L/Var*(y2-y1)
------------------------------------------------
hier beginnt die Datei „DIN336-1-param.dat“.
M 2, 2.00, 1.60, 2.2, 2.4, 2.6
M 2.5, 2.50, 2.05, 2.7, 2.9, 3.1
M 3, 3.00, 2.50, 3.2, 3.4, 3.6
M 3.5, 3.50, 2.90, 3.7, 3.9, 4.2
M 4, 4.00, 3.30, 4.3, 4.5, 4.8
M 5, 5.00, 4.20, 5.3, 5.5, 5.8
M 6, 6.00, 5.00, 6.4, 6.6, 7.0
M 8, 8.00, 6.75, 8.4, 9.0, 10.0
M10, 10.00, 8.50, 10.5, 11.0, 12.0
M12, 12.00, 10.25, 13.0, 13.5, 14.5
M16, 16.00, 14.00, 17.0, 17.5, 18.5
M20, 20.00, 17.50, 21.0, 22.0, 24.0
M22, 22.00, 19.50, 23.0, 24.0, 26.0
M24, 24.00, 21.00, 25.0, 26.0, 28.0
M27, 27.00, 24.00, 28.0, 30.0, 32.0
M30, 30.00, 26.50, 31.0, 33.0, 35.0
M33, 33.00, 29.50, 34.0, 36.0, 38.0
M36, 36.00, 32.00, 37.0, 39.0, 42.0
M39, 39.00, 35.00, 40.0, 42.0, 45.0
--------------------------------------------------
hier ist es zu ende
------------------
Reinhard
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
