Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

RE: Macro help

$
0
0

Hi Kamil,

may be this helps you:

Start the Primitive Function

Public Sub start()

    CommandState.StartPrimitive New IdentPoint

End Sub

Class Code:

Option Explicit

Implements IPrimitiveCommandEvents

Private anzahlPoints As Integer
Private A As Point3d
Private B As Point3d
Private C As Point3d



Private Sub IPrimitiveCommandEvents_Cleanup()

End Sub

Private Function GetRotation(p1 As Point3d, p2 As Point3d) As Matrix3d
    
    Dim pDiff As Point3d
    Dim pX As Point3d
    Dim angle As Double
    
    pDiff = Point3dSubtract(p2, p1)
    pDiff.Z = 0
    pX = Point3dFromXYZ(1, 0, 0)
    angle = Vector3dAngleBetweenVectorsXY(Vector3dFromPoint3d(pX), Vector3dFromPoint3d(pDiff))
    angle = angle + Pi / 2
    GetRotation = Application.Matrix3dFromAxisAndRotationAngle(2, angle)
    
End Function

Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal View As View)
    
    Dim line As LineElement
    Dim text As TextElement
    Dim Ciecie As Double
    Dim Color As Integer
    Dim Dx As Double
    Dim Dy As Double
    Dim Pz As Double
    Dim Z As String
    Dim rot As Matrix3d
    Dim lv As Level
    Dim ft As Font
    Dim ts As TextStyle
    
    If anzahlPoints = 0 Then
        A = Point
        anzahlPoints = anzahlPoints + 1
        CommandState.StartDynamics
        
        ShowPrompt "Ident second Point"
    Else
        B = Point
        
        If A.Z > B.Z Then
            C = A
            A = B
            B = C
        End If
        
        
        If (B.Z - A.Z) < 50 Then
        
            Set lv = ActiveModelReference.Levels.FindByNumber(1)
            Set ft = ActiveDesignFile.Fonts.Find(msdFontTypeWindowsTrueType, "Arial")
        
            rot = Matrix3dIdentity()
            rot = GetRotation(A, B)
            Set line = CreateLineElement2(Nothing, A, B)
            If Not (lv Is Nothing) Then
                Set line.Level = lv
            End If
            ActiveModelReference.AddElement line
            
            Ciecie = 0.5
            Dx = (B.X - A.X) / (B.Z - A.Z) * Ciecie
            Dy = (B.Y - A.Y) / (B.Z - A.Z) * Ciecie
            
            Pz = Ciecie - (A.Z - Fix(A.Z))
            While Pz <= 0
                Pz = Pz + Ciecie
            Wend
            
            C.Z = A.Z + Pz
            C.X = A.X + Pz * Dx / Ciecie
            C.Y = A.Y + Pz * Dy / Ciecie
            While C.Z < B.Z
                Color = (C.Z / 10 - Int(C.Z / 10)) * 10 / Ciecie
                Z = Format$(C.Z, "0,0.0")
                Z = Mid$(Z, Len(Z) - 2, Len(Z))
                
                Set text = CreateTextElement1(Nothing, Z, C, rot)
                text.Color = Val(Format$(Color, "0,0"))
                If Not (lv Is Nothing) Then
                    Set text.Level = lv
                End If
                Set ts = text.TextStyle
                If Not (ft Is Nothing) Then
                    Set ts.Font = ft
                End If
                ts.Justification = msdTextJustificationLeftCenter
                ts.Width = 0.25
                ts.Height = 0.25
                Set text.TextStyle = ts
                ActiveModelReference.AddElement text

                C.Z = C.Z + Ciecie
                C.X = C.X + Dx
                C.Y = C.Y + Dy
            Wend
        End If
        
        CommandState.StopDynamics
        CommandState.StartPrimitive Me

    End If
    
End Sub

Private Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
    
    Dim line As LineElement
    
    Set line = Application.CreateLineElement2(Nothing, A, Point)
    line.Redraw DrawMode
    
End Sub

Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)

End Sub

Private Sub IPrimitiveCommandEvents_Reset()
    CommandState.StartDefaultCommand
End Sub

Private Sub IPrimitiveCommandEvents_Start()
    anzahlPoints = 0
    ShowCommand "Place Marker"
    ShowPrompt "Ident first Point"
End Sub

Viewing all articles
Browse latest Browse all 7260

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>