| |  | 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 (2375 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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
 |