Ripristino sistema di coordinate WCS in VBA

rod316

Utente registrato
Professione: pensionato
Software: autocad
Regione: basilicata
#1
Tramite vba ho cambiato il sistema di coordinate da wcs a ucs e tramite delle Sub a elaborare figure nello spazio definite dal sistema ucs.
Ho necessità di ritornare nel sistema di coordinate wcs tramite comandi vba.
Grazie
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#2
Per ora accontentati di questo:
ThisDrawing.SendCommand "(command ""_ucs"" ""_w"") "
 

tracciatura.net

Utente poco attivo
Professione: Tecnico
Software: AutoCAD - Inventor - Tekla - Nesting
Regione: Piemonte
#4
Se magari posti il codice o la parte che cambia UCS...
comunque questo funziona ma l'ucs attuale deve avere un nome altrimenti da errore
Codice:
Sub f_ucsWorld()
    Dim po_ucs As AcadUCS
    Dim pd_X(2) As Double
    Dim pd_Y(2) As Double
    Dim pd_or(2) As Double
    
    pd_X(0) = 1: pd_X(1) = 0: pd_X(2) = 0
    pd_Y(0) = 0: pd_Y(1) = 1: pd_Y(2) = 0
    pd_or(0) = 0: pd_or(1) = 0: pd_or(2) = 0
    
    Set po_ucs = ThisDrawing.ActiveUCS
    po_ucs.XVector = pd_X
    po_ucs.YVector = pd_Y
    po_ucs.Origin = pd_or
    ThisDrawing.ActiveUCS = po_ucs
End Sub
 

rod316

Utente registrato
Professione: pensionato
Software: autocad
Regione: basilicata
#5
ciao "tracciatura.net"
il nome viene assegnato all'atto della creazione del nuovo ucs.
Di fatto ho creato un sub che viene richiamato all'occorrenza per con il solo parametro nome.
Nel sub scelgo tre punti che mi definiscono l'origine, asse x e asse y.

Public Sub nuovo_UCS(nome_UCS)
' Definisce un nuovo UCS

Dim OrigineNuovo_UCS(0 To 2) As Double
Dim PuntoAsse_X(0 To 2) As Double
Dim PuntoAsse_Y(0 To 2) As Double

UserForm1.HIDE

punto_origine_click = ActiveDocument.Utility.GetPoint(, "punto di origine")
assex_click = ActiveDocument.Utility.GetPoint(, "punto asse X")
assey_click = ActiveDocument.Utility.GetPoint(, "punto asse Y")

OrigineNuovo_UCS(0) = punto_origine_click(0): OrigineNuovo_UCS(1) = punto_origine_click(1): OrigineNuovo_UCS(2) = punto_origine_click(2)
PuntoAsse_X(0) = assex_click(0): PuntoAsse_X(1) = assex_click(1): PuntoAsse_X(2) = assex_click(2)
PuntoAsse_Y(0) = assey_click(0): PuntoAsse_Y(1) = assey_click(1): PuntoAsse_Y(2) = assey_click(2)

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(OrigineNuovo_UCS, PuntoAsse_X, PuntoAsse_Y, nome_UCS)
ThisDrawing.ActiveUCS = ucsObj
ThisDrawing.ActiveViewport.UCSIconOn = True
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Sub