Hallo Forum,
Als Neuling bei vb.net habe ich folgendes Problem:
Bei Fehlen eines bestimmten Blockes wird in einem Sub-Unterprogramm ein neuer Block mit einem Attribut mit TAG="Kat" und Textstring="REK" erstellt. Das funktioniert soweit auch so.
Der Block kann inkl.Attribut "händisch" problemlos geladen werden.
Wenn ich den Block jedoch mittels vb-Code lade, funktioniert das zwar auch, jedoch ist dann kein Attribut mehr dabei !!
Hier die aufrufende Prozedur:
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Module Mod2_ReKanal
Dim Winkel As Single
Dim nSchuß As Short, RestL As Short
Dim GesamtL As Integer
Dim Blockname As String
Dim Punkt2 As New Point3d
Sub Kanal(ByVal Punkt1, ByVal a, ByVal b, ByVal SL)
Dim Winkel As Single
Dim nSchuß As Short, RestL As Short
Dim GesamtL As Integer
Dim Blockname As String
Dim Punkt2 As New Point3d
Sub Kanal(ByVal Punkt1, ByVal a, ByVal b, ByVal SL)
Dim PunktCol2d As New Point2dCollection
'Sub für Punktdefinition:
Call ZweitPunkteingabe("2.Punkt", Punkt1, Punkt2)
'1.Trans.:Hilfslinie für Block zeichnen und auswerten:
Using acTrans As Transaction = ThisDrawingDB.TransactionManager.StartTransaction()
acBT = acTrans.GetObject(ThisDrawingDB.BlockTableId, OpenMode.ForRead) '...BT der akt.Zng. zum Lesen öffnen.
acBTR = acTrans.GetObject(acBT(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '...BTR der akt.Zng.zum Schreiben öffnen.
Dim HLinie As Line = New Line(Punkt1, Punkt2)
HLinie.SetDatabaseDefaults()
HLinie.LineWeight = LineWeight.ByLayer
acBTR.AppendEntity(HLinie) '... die neue Linie an Blocktabellen-Record anhängen.
Winkel = HLinie.Angle
GesamtL = HLinie.Length
nSchuß = Int(GesamtL / SL)
RestL = GesamtL - nSchuß * SL
HLinie.Erase()
acTrans.AddNewlyCreatedDBObject(HLinie, True)
acTrans.Commit()
End Using
Blockname = "Kanal" & Füllfarbe & "_" & a
'wenn Block nicht in BT dann neu generieren:
If Not acBT.Has(Blockname) Then
PunktCol2d.Add(New Point2d(0, -a / 2))
PunktCol2d.Add(New Point2d(1, -a / 2))
PunktCol2d.Add(New Point2d(1, a / 2))
PunktCol2d.Add(New Point2d(0, a / 2))
Call Blockgenerator(PunktCol2d, Blockname)
End If
'2.Trans.:generierte Blockdef. als Blockreferenz einfügen:
Using acTrans As Transaction = ThisDrawingDB.TransactionManager.StartTransaction()
acBT = acTrans.GetObject(ThisDrawingDB.BlockTableId, OpenMode.ForRead) '...BT der akt.Zng. zum Lesen öffnen.
acBTR = acTrans.GetObject(acBT(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '...BTR der akt.Zng.zum Schreiben öffnen.
Dim BlockRef As New BlockReference(Punkt1, acBT(Blockname))
BlockRef.SetDatabaseDefaults()
BlockRef.Rotation = Winkel
BlockRef.ScaleFactors = New Scale3d(SL, 1, 1)
'Attributreferenzen editieren:
Dim AttCol As AttributeCollection = BlockRef.AttributeCollection
Dim AttRef_Kat As AttributeReference
AttRef_Kat = AttCol(0).GetObject(OpenMode.ForWrite)
AttRef_Kat.TextString = "Mamaburli"
acBTR.AppendEntity(BlockRef)
acTrans.AddNewlyCreatedDBObject(BlockRef, True)
acTrans.Commit()
End Using
End Sub
Zur Vervollständigung noch der "Blockgenerator":
Public Sub Blockgenerator(ByVal PunktCol2d, ByVal Blockname)
Using acTrans As Transaction = ThisDrawingDB.TransactionManager.StartTransaction()
Dim TextstyleID As ObjectId = ThisDrawingDB.Textstyle
Dim Block As BlockTableRecord
Dim BlockID As ObjectId
Dim Punkt As Point2d
Dim Index As Integer = 0
acBT = acTrans.GetObject(ThisDrawingDB.BlockTableId, OpenMode.ForWrite)
Block = New BlockTableRecord '...neuen BTR (=Block) generieren.
Block.Name = Blockname
BlockID = acBT.Add(Block) '...neuen Block zum BT hinzufügen.
acTrans.AddNewlyCreatedDBObject(Block, True)
'zuerst Blockelement Schraff erzeugen (damit Schraff unten liegt):
Dim Schraff As Hatch = New Hatch
Block.AppendEntity(Schraff)
acTrans.AddNewlyCreatedDBObject(Schraff, True)
Schraff.SetDatabaseDefaults()
Schraff.SetHatchPattern(HatchPatternType.PreDefined, "solid")
Schraff.ColorIndex = Füllfarbe
'dann erst Blockelement LPoly erzeugen:
Dim LPoly As Polyline = New Polyline
LPoly.SetDatabaseDefaults()
For Each Punkt In PunktCol2d
LPoly.AddVertexAt(Index, Punkt, 0, 0, 0)
Index = Index + 1
Next
LPoly.Closed = True
Block.AppendEntity(LPoly)
acTrans.AddNewlyCreatedDBObject(LPoly, True)
'Umgrenzung von Schraff definieren:
Dim ObjIdColl As ObjectIdCollection = New ObjectIdCollection
ObjIdColl.Add(LPoly.ObjectId)
Schraff.AppendLoop(HatchLoopTypes.Outermost, ObjIdColl) '...Umgrenzung von Schraff
Schraff.EvaluateHatch(True)
'Attribute definieren:
Dim Att_Kat As AttributeDefinition = New AttributeDefinition(New Point3d(0, 0, 0), "REK", "Kat", "Kategorie", TextstyleID)
Block.AppendEntity(Att_Kat)
acTrans.AddNewlyCreatedDBObject(Att_Kat, True) : MsgBox(Att_Kat.TextString)
acTrans.Commit()
End Using
End Sub
Was läuft da nur schief !?
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
