| | |
 | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| | |
 | PNY wird von NVIDIA zum Händler des Jahres gewählt - zum dritten Mal in Folge, eine Pressemitteilung
|
|
Autor
|
Thema: Objekt an selektierter Linie ausrichten (2393 mal gelesen)
|
Boehri
Mitglied
   Beiträge: 80
Registriert: 07.04.2008
|
erstellt am: 18. Jan. 2011 14:32  <-- editieren / zitieren -->   Unities abgeben:          
Ich schon wieder, ich habe eine Routine geschrieben in der eine linie selektiert wird. Danach wird nach dem Einfügepunkt auf der Linie gefragt. Danachch wird ein dynamischer Block eingefügt und auf einen entsprechenden Layer gesetzt. Dies klappt auch alles wunderbar. Nur richtet sich der eingefügte Block nicht an der Linie aus obwohl in diesem ein Ausrichtungsgriff enthalten ist. Der Block steht immer in Richtung x-Achse. Erst wenn ich den Block ein wenig schiebe wird er ausgerichtet. Welche möglichkeit gibts es das Objekt mittels Code auszurichten. Eine Möglichkeit wäre vielleicht ihn entlang der Linie zu verschieben. Den Start- und Endpunkt der Linie hab ich ja. Ich habs mal so versucht: Code:
Dim pt1 As Point3d = Line.StartPoint
Dim pt2 As Point3d = Line.EndPointWinkel = pt1.GetVectorTo(pt2).AngleOnPlane(New Plane)
Code:
Public Sub hzInsertBlockMSWithAttributes(ByVal pntInsert As Point3d, _
ByVal strBlockName As String, _
ByVal dScale As Double, _
ByVal strLayerName As String, _
ByVal arrAttrValues As ArrayList, _
ByVal strLayersuffix As String, _
ByVal intLayerfarbe As Integer, _
ByVal Winkel As Double)
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurdb As Database = acDoc.Database Try
Using tr As Transaction = acCurdb.TransactionManager.StartTransaction
Dim bt As BlockTable = acCurdb.BlockTableId.GetObject(OpenMode.ForRead)
Dim btrMS As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
If Not bt.Has(strBlockName) Then
Exit Sub
Else
btrMS.UpgradeOpen()
End If
Dim btr As BlockTableRecord = bt(strBlockName).GetObject(OpenMode.ForWrite)
Dim bref As New BlockReference(pntInsert, btr.ObjectId) ' Wipeout nach unten legen
Dim acObjId As ObjectId
Dim ent As Entity
For Each acObjId In btr
If (acObjId.IsValid) AndAlso (Not acObjId.IsErased) Then
ent = CType(tr.GetObject(acObjId, OpenMode.ForWrite), Entity)
If ent.GetType.ToString = "Autodesk.AutoCAD.DatabaseServices.Wipeout" Then
Dim ids As ObjectIdCollection = New ObjectIdCollection()
btr.DowngradeOpen()
ids.Add(ent.ObjectId)
Dim dot As DrawOrderTable = tr.GetObject(btr.DrawOrderTableId, OpenMode.ForWrite)
dot.MoveToBottom(ids)
End If
End If
Next 'Block drehen
Dim curUCSMatrix As Matrix3d = acDoc.Editor.CurrentUserCoordinateSystem
Dim curUCS As CoordinateSystem3d = curUCSMatrix.CoordinateSystem3d
bref.TransformBy(Matrix3d.Rotation(Winkel, curUCS.Zaxis, pntInsert))
btrMS.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
'Objekt auf Layer setzen und ggfls. neuen Layer erstellen
create_new_layer(strLayerName & strLayersuffix, intLayerfarbe)
' set annotation scale if block is annotative
If btr.Annotative = AnnotativeStates.True Then
Dim ocm As ObjectContextManager = acCurdb.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
Autodesk.AutoCAD.Internal.ObjectContexts.AddContext(bref, occ.CurrentContext)
End If
' Objekt auf Layer setzen
bref.Layer = strLayerName & strLayersuffix
' commit
tr.Commit
Leider dreht sich da nix :-) Ich denke es liegt hieran Code:
bref.TransformBy(Matrix3d.Rotation(Winkel, New Vector3d(0, 0, 1), pntInsert))
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer
Beiträge: 9812
Registriert: 01.12.2003 AutoCAD 20xx, Civil 3D 201x, Inventor Prof 201x usw.
|
erstellt am: 18. Jan. 2011 14:49 <-- editieren / zitieren --> Unities abgeben: Nur für Boehri 
|
Boehri
Mitglied
Beiträge: 80
Registriert: 07.04.2008
|
erstellt am: 18. Jan. 2011 15:54 <-- editieren / zitieren --> Unities abgeben:
Hallo Udo, danke für die Antwort hab es mittlerweile rausgefunden.
So funktionierts. Code:
'Block(drehen)
Dim curUCSMatrix As Matrix3d = acDoc.Editor.CurrentUserCoordinateSystem
Dim curUCS As CoordinateSystem3d = curUCSMatrix.CoordinateSystem3d bref.TransformBy(Matrix3d.Rotation(Winkel, curUCS.Zaxis, pntInsert))
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Boehri
Mitglied
Beiträge: 80
Registriert: 07.04.2008
|
erstellt am: 19. Jan. 2011 07:51 <-- editieren / zitieren --> Unities abgeben:
Ich nochmal, muss mich korrigieren. Es funktioniert bei Linien einwandfrei, jedoch bei Polylinien wie erwartend nicht.
Wenn ich den Start und Endpunkt der PLinie auswerte bekomme ich natürlich einen falschen Winkel berechnet wenn diese auf der X- und der Y-Achse verläuft. Code:
pntAnfang = PLine.StartPoint
pntEnde = PLine.EndPoint
Code:
Winkel = pntAnfang.GetVectorTo(pntEnde).AngleOnPlane(New Plane)
vRot = pntAnfang.GetVectorTo(pntEnde)
Nun meine Frage:
Kann mann die Start- und Endpunkte für das gepickte Segment einer Plinie auswerten. Ich denke da evtl. an die Griffe. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| |
Boehri
Mitglied
Beiträge: 80
Registriert: 07.04.2008
|
erstellt am: 20. Jan. 2011 08:29 <-- editieren / zitieren --> Unities abgeben:
Eigentlich ganz einfach, bisschen Googeln sollte man vorher  Code:
If PLine IsNot Nothing Then
For i As Long = 0 To PLine.NumberOfVertices - 2 ' 2 bei nicht geschlossenen Polylinien
If (PLine.GetLineSegmentAt(i).IsOn(ptSelect)) Then
pntAnfang = PLine.GetLineSegmentAt(i).StartPoint
pntEnde = PLine.GetLineSegmentAt(i).EndPoint
End If
Next
strLayername = PLine.Layer.ToString
End If
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Foren auf CAD.de
| 
