CADsite forum

Hallo,

weet iemand ofdat je u ucs via vba kan veranderen? zo ja dan u ucs world.
of welk commando ik ervoor moet gebruiken.

MVG

thomy

Di heb ik ook al voorgehad in mijn programma, met dit werkt het prima:
Je moet dit voor hetgeen plaatsen wat je wilt verzetten.

'verplaatsen  Vooraanzicht ten opzichte van de Horizontale Doorsnede:
    On Error Resume Next
        Set SelSetOb = ThisDrawing.SelectionSets.Item("ssetje")
        If Err Then
        Set SelSetOb = ThisDrawing.SelectionSets.Add("ssetje")
        Err.Clear
        Else
        SelSetOb.Clear
        End If

        SelSetOb.Select acSelectionSetAll

        verplaatspunt1(1) = 0
        verplaatspunt1(2) = Val(.txtTDK) + 500

        For Each Obj In SelSetOb
        Obj.Move verplaatspunt1, verplaatspunt2

        Next

        SelSetOb.Delete

grtz

yaryd

Citaat van: Thomy op di 17 03 2009, 16:51:41
Hallo,

weet iemand ofdat je u ucs via vba kan veranderen? zo ja dan u ucs world.
of welk commando ik ervoor moet gebruiken.

MVG

thomy

Sub test1()
ThisDrawing.SendCommand "ucs" & vbCr & "world" & vbCr
End Sub
of
Sub test2()
Dim wcs As Object
Dim dorigin(0 To 2) As Double
Dim dxAxisPnt(0 To 2) As Double
Dim dyAxisPnt(0 To 2) As Double
dorigin(0) = 0#
dorigin(1) = 0#
dorigin(2) = 0#
dxAxisPnt(0) = 1#
dxAxisPnt(1) = 0#
dxAxisPnt(2) = 0#
dyAxisPnt(0) = 0#
dyAxisPnt(1) = 1#
dyAxisPnt(2) = 0#
Set wcs = ThisDrawing.UserCoordinateSystems.Add(dorigin, dxAxisPnt, dyAxisPnt, "WORLD")
ThisDrawing.ActiveUCS = wcs
End Sub
of
Sub test3()
Set ACAD = GetObject(, "AutoCAD.Application")
Set DOC = ACAD.ActiveDocument
Set UCSs = DOC.UserCoordinateSystems
ThisDrawing.ActiveUCS = UCSs.Item("WORLD")
End Sub

Met vriendelijke groet, HofCAD CSI.

hej

merci voor deze tips ga deze ook zo snel mogelijk uittesten. zodra de rest van mijn programma inorde is.
groote dank hiervoor

Mvg

Thomy