---

Hello,

my name is Christophe Claeys from Belgium.
I'm working on a project for my finals for school: programming a variable 3D-presentation program for kitchen designs.

But I'm being held back by this problem involving changing the UCS in modelspace for further drawing.

I can change the UCS and the selected UCS is then shown in AutoCAD modelspace but when I draw something AutoCAD doesn't use my new UCS (still the UCS icon shows my new UCS)

The new origin is OK, but the direction of X and Y doesn't change...

What do I do wrong?

Here's the code:

Private Sub Werkbladtekenen()

    ' define new UCS for drawing
    Dim BladUCS As AcadUCS
    Dim oorsprong As Variant
    Dim XasPunt As Variant
    Dim YasPunt As Variant
    Dim UCSnaam As String
    oorsprong = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Duid de oorsprong aan:")
    XasPunt = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Duid een punt op de X-as aan (breedte blad):")
    YasPunt = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Duid een punt op de Y-as aan (lengte blad):")
    UCSnaam = Change
   
    Set BladUCS = ThisDrawing.UserCoordinateSystems.Add _
    (oorsprong, XasPunt, YasPunt, "UCSnaam")
    ACADProject.ThisDrawing.ActiveUCS = BladUCS
   
    ' the length, width and higth of the box are given by input
    werkbladlengte = ACADProject.ThisDrawing.Utility.GetDistance _ 
    (, "Geef de lengte van het werkblad: ")
    werkbladbreedte = ACADProject.ThisDrawing.Utility.GetDistance _
    (, "Geef de breedte van het werkblad: ")
    werkbladdikte = ACADProject.ThisDrawing.Utility.GetDistance _
    (, "Geef de dikte van het werkblad: ")
    insertpoint(0) = oorsprong(0) + werkbladbreedte / 2
    insertpoint(1) = oorsprong(1) + werkbladlengte / 2
    insertpoint(2) = oorsprong(2) + werkbladdikte / 2
    Set werkblad = ThisDrawing.ModelSpace.AddBox _
    (insertpoint, werkbladbreedte, werkbladlengte, werkbladdikte)
    werkblad.Update
           
End Sub

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

---

Hello Christophe.

This is a Bug in AutoCAD-VBA.

I had the same Problem changing the UCS for inseting a block.

Try it like this:

Public Sub Feder()
Dim actlayer As AcadLayer
Dim layalt As AcadLayer
Set layalt = ThisDrawing.ActiveLayer
Set actlayer = ThisDrawing.Layers("0")
Dim objBlockRef As AcadBlockReference
Dim EinfügePT(0 To 2) As Double
Dim Punkt0, Punkt1 As Variant
Dim Punkt2(0 To 2) As Double
On Error Resume Next
ThisDrawing.ActiveLayer = actlayer
ThisDrawing.ActiveSpace = acModelSpace
Punkt0 = ThisDrawing.Utility.GetPoint( _
    , "Bitte 1. Punkt wählen: ")
Punkt1 = ThisDrawing.Utility.GetPoint( _
    , "Bitte 2. Punkt wählen: ")
Dim retangle, Winkel As Variant
retangle = ThisDrawing.Utility.AngleFromXAxis(Punkt0, Punkt1)
Winkel = retangle + 4.71239
EinfügePT(0) = (Punkt0(0) + Punkt1(0)) / 2: EinfügePT(1) = (Punkt0(1) + Punkt1(1)) / 2: EinfügePT(2) = (Punkt0(2) - Punkt1(2)) / 2
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(EinfügePT, "c:\ACAD\Blöcke\feder.dwg", 1#, 1#, 1#, Winkel)
ThisDrawing.ActiveLayer = layalt
End Sub

Hope it helps.

with regards, Carsten...

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

---

Thank You Carsten!

I did not use the code you gave because I didn't need to import Blocks but somehow you gave me a good idea to solve my problem, so you you were indeed a big help!!!

What I'm trying to do now in the program is to choose a new UCS and draw solids with it. But since it can't be changed I wrote a piece of code to go round that.

The origin can be changed that's no problem. When you choose a new UCS the icon shows the chosen one but AutoCAD has only changed the origin. The direction of X and Y stay like in the WCS.
So when I try to choose a new UCS I give the coördinates for X and Y a value by variable (they stay WCS values)
After drawing a solid (in my new UCS, but still WCS) I rotate the solid depending on how the X- and Y-axis are oriented in the new UCS.

Anyway, here's the code:

Private Sub DrawSolid()

    Dim ObjUCS As AcadUCS
    Set ObjUCS = ACADProject.ThisDrawing.ActiveUCS
   
    ' define my new UCS like it would actually change afterwards
    Dim newUCS As AcadUCS
    Dim origin As Variant
    Dim XaxisPoint As Variant
    Dim YaxisPoint As Variant
    origin = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Give new origin:")
    XaxisPoint = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Give point on new X-axis:")
    YaxisPoint = ACADProject.ThisDrawing.Utility.GetPoint _
    (, "Give point on new Y-axis:")
   
    ' define the x coordinates of the chosen point for X and Y
    Dim Xas As Double
    Dim Yas As Double
    Xas = XaxisPoint (0)
    Yas = YaxisPoint (0)
       
    Set newUCS = ThisDrawing.UserCoordinateSystems.Add _
    (origin, XaxisPoint , YaxisPoint , "UCS1")
    ' show icon as for new UCS
    ACADProject.ThisDrawing.ActiveUCS = newUCS
      
    ' draw box
    Dim BoxSolid as Acad3DSolid
    Dim insertpoint (0 to 2) as Double
    insertpoint (0) = origin(0) + 1000 / 2
    insertpoint (1) = origin(1) + 2000 / 2
    insertpoint (2) = origin(2) + 500 / 2
    Set BoxSolid = ThisDrawing.ModelSpace.AddBox _ 
    (insertpoint , 1000, 2000, 500)
       
    ' depending on the previous defined x-coordinates for X and Y
    ' we're gonna see if the new UCS has rotated around Z and if so
    ' we're going to rotate the BoxSolid as well
    If Xas < Yas Then
        ' define second point on Z for rotation axis definition
        Dim originZ(0 To 2) As Double
        Dim angle As Double
        originZ(0) = origin(0)
        originZ(1) = origin(1)
        originZ(2) = origin(2) + 100
        angle = 270
        pi = 4 * Atn(1)
        angle = (angle / 180) * pi
        werkblad.Rotate3D origin, originZ, angle
    End If

End Sub

There you have it, it works for me and for now that's enough ; )

Thanks again!

Christophe

[Diese Nachricht wurde von truuck am 22. Apr. 2005 editiert.]

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