---

Hi,
Ich versuche gerade eine komplette Zeichnung mittels Drehwinkel, Verschiebevektor und Massstab zu Modifizieren, bei den Zeichenelementen war das auch kein Problem, da lief das über eine Transformationsmatrix und der anschließenden Anwendung der Methode Element.transform,
Aber bei Raster funktioniert nur eine Drehung, aber ich konte keine Befehle finden zum skalieren und verschieben.
Vielleicht hat ja einer das schon mal gemacht

hier jedenfalls der Status Quo:

Sub test_Raster_Drehen_Skalieren_Verschieben(DrehWinkel_Radiant As Double, vx As Double, vy As Double, vz As Double, MassStab As Double)
 
  Dim theRasters As Rasters
  Dim oRaster As Raster
  Dim oEnum As CollectionEnumerator
 
  Set theRasters = RasterManager.Rasters
    For Each oRaster In theRasters 'Re
      With oRaster.GeoReferenceInformation
        MsgBox .RotationAboutZ & vbCrLf _
        & .Origin.x & vbCrLf _
        & .Origin.Y & vbCrLf _
        & .Origin.Z & vbCrLf _
        & oRaster.RasterInformation.WorldFileType _
        , , oRaster.RasterInformation.Name
   
      'Raster um Ursprung drehen (geht trotz ReadOnly)
        .RotationAboutZ = DrehWinkel_Radiant
   
      'Raster-Ursprung verschieben
      'geht nicht, da GeoReferenceInformation-Objekt eigentlich Readonly (außer bei Drehung s.o.)
        .Origin.x = .Origin.x + vx
        .Origin.Y = .Origin.Y + vy
        .Origin.Z = .Origin.Z + vz
     
      'Raster Skalieren bezogen auf Ursprung
        '??? (keine Methode gefunden)
      End With
     
    Next
 
  RedrawAllViews
End Sub

schon mal Danke

Gruß Jo

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

---

Raster.GIF

Hallo,
Versuch es mit Rastersteuerung zu finden unter -> Funktionen -> Raster -> Rastersteuerung, da kannst Du Skalieren, Umwandeln (Einpassen mit Ref. Punkten) etc. diese Funktionen findest Du auch im Rastermanager, am besten selbst testen.

Gruß
Franz

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

---

Hallo Franz,
Danke für die Antwort,
ich hab' rumprobiert und es hat geklappt mit den SendCommands, ist nur Schade, dass es für Raster keine VBA-Methode "Transform" gibt, wie bei den restlichen graphischen Elementen.
Hier also die Lösung:

Sub Raster_Drehen_Skalieren_Verschieben(DrehWinkel_Radiant As Double,Bezugspunkt1 As Point3d,vx as double,vy as double, vz as double, MassStab As Double)
 
  Dim theRasters As Rasters
  Dim oRaster As Raster
  Dim oEnum As CollectionEnumerator
 
  Dim Bezugspunkt2 As Point3d
  Dim Alt_MassStab As Point2d
  Dim Alt_Drehung_Radiant As Double
  Dim Neu_MassStab As Point2d
  Dim FullName As String
 
  Dim Neu_Pkt As Point3d
 
  'Einstellungen (der Transformationsparameter)
    ActiveSettings.Angle = DrehWinkel_Radiant    'Drehwinkel in Radiant
  'Drehwinkel setzen
  'Alternative funktioniert auch!)
    'CadInputQueue.SendCommand "ACTIVE ANGLE " & Replace(Str(DrehWinkel_Radiant * 180 / Application.Pi), ",", ".") & "°"
  'Massstab setzen
    CadInputQueue.SendCommand "ACTIVE SCALE " & Replace(Str(MassStab), ",", ".")
 
  'Alternative Funktioniert nicht!)
    'ActiveSettings.ScaleLockEnabled = False
    'ActiveSettings.Scale.x = MassStab
    'ActiveSettings.Scale.Y = MassStab
    'ActiveSettings.Scale.Z = 1

  '0. Berechnung verschobener Bezugspunkt
        Bezugspunkt2.x = Bezugspunkt1.x + vx
        Bezugspunkt2.y = Bezugspunkt1.y + vy
        Bezugspunkt2.z = Bezugspunkt1.z + vz

  '1. Gesamte Rasterauswahl demarkieren (darf nur eins markiert sein für Bearbeitung)
  Set theRasters = RasterManager.Rasters
    For Each oRaster In theRasters 'Re
      oRaster.ExtendedInformation.IsSelected = False
    Next
   
    For Each oRaster In theRasters
      With oRaster.GeoReferenceInformation
      oRaster.ExtendedInformation.IsSelected = True      'Einzelnes Raster Auswählen

  '2.Verschieben-------------------------------------------------
      'Verschiebungspunkt berechnen
        CadInputQueue.SendCommand "RASTER MOVE"
        CadInputQueue.SendDataPoint Bezugspunkt1 'UrsprBezugspunkt für Verschiebung
        CadInputQueue.SendDataPoint Bezugspunkt2 'ZielBezugspunkt für Verschiebung
        'Reset zu aktuellem Befehl senden.
        CadInputQueue.SendReset
        CommandState.StartDefaultCommand
    '3.Drehen------------------------------------------------------
      's.o.:        ActiveSettings.Angle = DrehWinkel_Radiant    'Drehwinkel in Radiant
        CadInputQueue.SendCommand "RASTER ROTATE "
        CadInputQueue.SendDataPoint Bezugspunkt2          'Bezugspunkt für Drehung
      'Reset zu aktuellem Befehl senden.
        CadInputQueue.SendReset
        CommandState.StartDefaultCommand
       
    '4.Skalieren------------------------------------------------------
      's.o.:      CadInputQueue.SendCommand "ACTIVE SCALE "  'Masstab
        CadInputQueue.SendCommand "RASTER SCALE "
        CadInputQueue.SendDataPoint Bezugspunkt2          'Bezugspunkt für Skalierung
      'Reset zu aktuellem Befehl senden.
        CadInputQueue.SendReset
        CommandState.StartDefaultCommand
     
      oRaster.ExtendedInformation.IsSelected = False      'Auswahl löschen
      End With
    'oRaster.Reload
    Next

    'Einstellungen (zurücksetzen)
    ActiveSettings.Angle = 0    'Drehwinkel in Radiant
    CadInputQueue.SendCommand "ACTIVE SCALE 1 "
   
    'Reset zu aktuellem Befehl senden.
      CadInputQueue.SendReset
      CommandState.StartDefaultCommand
 
  'Regenerieren
  RedrawAllViews
End Sub

Gruß Jo

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