---

Hallo,

ich arbeite an einem Makro, dass Skizzenobjekte von einer Skizze in eine andere kopiert.
Ich befinde mich also in der Umgebung der Bauteilbearbeitung und habe eine Skizze aktiviert. Das Makro kopiert mir nun gewisse Skizzenobjekte in diese aktive Skizze, jedoch immer an den selben Punkt wie in der Quellskizze (meistens nahe des Ursprungs). Ich möchte nun nach dem Kopiervorgang die kopierten Skizzenobjekte in die Mitte der aktuellen Kameraansicht auf der Skizze verschieben (je nachdem wo man in der Skizze gerade hinschaut).

Der Befehl dafür lautet oSketch.MoveSketchObjects(SketchObjects, Vector2d,...) Nun benötige ich nur mehr den Vektor vom Ursprung zum aktuellen Kameramittelpunkt und komme leider selber nicht weiter. Bitte um Hilfe.

Grüße, Joscha.

------------------
"ENGINEER"

noun. [en-juh-neer]

Someone who does precision
guesswork based on unreliable
data provided by those of
questionable knowledge

See also wizard, magician

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

---

Moin

Also vom Ablauf würde ich sagen, das Camera.Target des aktiven Views ist ein Point. Den kann man mit ModelToSketchSpace in einen Point2D im Skizzenraum konvertieren und dann ist der Vektor gleich den X,Y-Koordinaten des Punktes, oder?
Das Makro setzt ein Bauteil mit aktiver Skizzenbearbeitung voraus.

EDIT: Nö, zu früh gefreut. Die Kamera behält die Werte bevor die Skizzenumgebung aktiviert wurde. 

Code:

---

Option Explicit

Private Sub sketchvector()

Dim oApp As Inventor.Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

Dim oSketch As PlanarSketch
Set oSketch = oApp.ActiveEditObject

Dim oView As View
Set oView = oApp.ActiveView

Dim oCam As Camera
Set oCam = oView.Camera

Dim oTarget As Point
Set oTarget = oCam.Target

Dim oTPoint As Point2d
Set oTPoint = oSketch.ModelToSketchSpace(oTarget)

Dim oVector2D As Vector2d
Set oVector2D = oApp.TransientGeometry.CreateVector2d(oTPoint.x, oTPoint.y)

End Sub

---

------------------
MfG
Ralf

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

---

Moin

Das ist wirklich etwas seltsam. Wenn ich das Skizzenobjekt direkt verschiebe, landet es irgendwo. Wenn ich es erst kopiere und dann das Original lösche scheint es zu funktionieren. Kannst du das bei dir mal testen?

Code:

---

Private Sub sketchvector()

Dim oApp As Inventor.Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

Dim oSketch As PlanarSketch
Set oSketch = oApp.ActiveEditObject

Dim oView As View
Set oView = oApp.ActiveView

Dim oCam As Camera
Set oCam = oView.Camera

Dim oTarget As Point
Set oTarget = oCam.Target

Dim oTPoint As Point2d
Set oTPoint = oSketch.ModelToSketchSpace(oTarget)

Dim oVector2D As Vector2d
Set oVector2D = oApp.TransientGeometry.CreateVector2d(oTPoint.x, oTPoint.y)

Dim oSketchObjects As ObjectCollection
Set oSketchObjects = oApp.TransientObjects.CreateObjectCollection

Dim oSketchEnt As SketchEntity
Set oSketchEnt = oApp.CommandManager.Pick(kSketchDefaultFilter, "Pick something")

Call oSketchObjects.Add(oSketchEnt)

Call oSketch.MoveSketchObjects(oSketchObjects, oVector2D, True, True)

Dim oItem As SketchEntity
For Each oItem In oSketchObjects
    oItem.Delete
Next

End Sub

---

------------------
MfG
Ralf

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

---

Screenshot2024-09-14140730.jpg

Hallo Ralf,

sorry für die späte Rückmeldung. Dein Code hat mir weitergeholfen, musste ihn aber etwas abändern.
Der Befehl MoveSketchObjects mit "True" für Objekte kopieren war leider keine Option, da die Skizze mit Bemaßungen/Parameter kopiert wird und diese umbenannt sind und die Namen der Parameter beim kopieren verloren gehen.
ABER, mir ist aufgefallen, dass die Skizzenobjekte immer doppelt so weit weg verschoben werden, als wo meine Ansicht hinschaut. Pragmatisch wie ich bin habe ich also die Werte oTPoint.x und oTPoint.y durch 2 dividiert und siehe da, die Skizzenobjekte werden genau in Ansichtsmittelpunkt verschoben. Warum dividiert durch 2? Frag mich nicht. War trial and error.

Nun habe ich nur mehr das "kosmetische" Problem, dass eine Bemaßung extrem lang angezeigt wird. Hast du eine Idee dazu?

MfG, Joscha

------------------
"ENGINEER"

noun. [en-juh-neer]

Someone who does precision
guesswork based on unreliable
data provided by those of
questionable knowledge

See also wizard, magician

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

---

Moin

Warum das doppelt so weit schiebt kann ich dir auch nicht erklären. Bei mir zeigte sich das Verhalten nicht. Es ist sowieso etwas undefiniert wo die Kamera hinschaut. Das Target liegt ja irgendwo im 3-dimensionalen Raum und wird entlang der Flächennormale der Fläche auf der die Skizze definiert ist projeziert. Oder so ähnlich, Autodesk schreibt zu sowas nicht gerade Romane als Doku.  

Die Bemaßungen (DimensionConstraints) in einer Skizze haben ein Property "TextPosition" als Point2D, das die Position angibt. Die Werte des Point2D müsste man anpassen. Bei einer Bemaßung sind im Property "AnchorPoints" zwei Punkte, deren Mittelwert man berechnen könnte. Von diesem "Mittelpunkt" aus erzeugt man sich einen Vektor zur aktuellen Textposition. Diesen Vektor konvertiert man, weil es so schön einfach geht, in einen UnitVektor und diesen wieder zurück in einen Vektor. Damit hat man einen Vektor in der korrekten Ausrichtung mit etwa 1cm Versatz erzeugt. Man könnte auch den Vektor vervielfachen (Variable dFaktor), wenn man mehr Abstand braucht. Dann transformiert (verschiebt) man den Mittelpunkt mit dem Vektor und nimmt den entstehenden Punkt als neue TextPosition.
Mit linearen, ausgerichteten und Radialbemaßungen hat es in einem schnellen Test funktioniert. Mal sehen wo das nicht funktioniert.

Code:

---

Option Explicit

Private Sub MoveSketchDims()

Dim dFaktor As Double
dFaktor = 2.5

Dim oApp As Inventor.Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

Dim oSketch As PlanarSketch
Set oSketch = oDoc.ActivatedObject

Dim oDimCons As DimensionConstraint
For Each oDimCons In oSketch.DimensionConstraints
    Dim oAnchorPoint1 As Point2d
    Set oAnchorPoint1 = oDimCons.AnchorPoints(1)
   
    Dim oAnchorPoint2 As Point2d
    Set oAnchorPoint2 = oDimCons.AnchorPoints(2)
   
    Dim oMidPoint As Point2d
    Set oMidPoint = oApp.TransientGeometry.CreatePoint2d((oAnchorPoint1.x + oAnchorPoint2.x) / 2, (oAnchorPoint1.y + oAnchorPoint2.y) / 2)
   
    Dim oVector As Vector2d
    Set oVector = oMidPoint.VectorTo(oDimCons.TextPoint)
   
    Dim oUnitvector As UnitVector2d
    If oVector.Length > 0 Then
        Set oUnitvector = oVector.AsUnitVector
    Else
        Set oUnitvector = oApp.TransientGeometry.CreateUnitVector2d(dFaktor, dFaktor)
    End If
   
    Set oVector = oUnitvector.AsVector
    Call oVector.ScaleBy(dFaktor)
   
    Call oMidPoint.TranslateBy(oVector)
   
    oDimCons.TextPoint = oMidPoint
Next

End Sub

---

------------------
MfG
Ralf

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