AVAX-software.com Forums: Make your own Trim command - AVAX-software.com Forums

Jump to content

Page 1 of 1

Make your own Trim command

#1 User is offline   Athanasios Gardos Icon

  • Administrator
  • Icon
  • Group: Admin
  • Posts: 333
  • Joined: 21-March 05
  • Gender:Male

Posted 24 June 2008 - 10:23 AM

VB6 source code on how to make your own Trim command:
Option Explicit

Dim oMath As cAvaxMath

Private Sub cAvax1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        cAvax1.Command = Cancel_c
    End If
End Sub

Private Sub cAvax1_SelectedPoints(SelectId As String, lPointNumber As Long, x1() As Single, y1() As Single, z1() As Single)
    Dim h() As Long
    Dim lCnt As Long
    Dim lMax As Long
    Dim iType() As AvaxItemType
    Dim vProp() As Variant
    Dim vData() As Variant
    Dim xyz() As Single, jCnt As Long
    Dim x1d As Single, y1d As Single
    Dim cx As Single, cy As Single
    Dim aR As Single, bR As Single
    Dim xV() As Single, yV() As Single, zV() As Single
    Dim dAngle As Single, done%, ok As Single
    Dim A As Single, B As Single, C As Single
    Dim fOk As Boolean
    Dim ToDelH() As Long
    Dim dMax As Single, d1 As Single, d2 As Single
    Dim p1x() As Single, p1y() As Single, p1z() As Single
    Dim p2x() As Single, p2y() As Single, p2z() As Single
    Dim Angle1 As Single, Angle2 As Single
    Dim xNew1 As Single, yNew1 As Single
    Dim xNew2 As Single, yNew2 As Single
    Dim lCount As Long
    ReDim ToDelH(1) As Long
    ReDim mat3x3(3, 3) As Single
    If SelectId = "My_Trim" Then
        If lPointNumber = 1 Then
            cAvax1.Command = Nearest_c
        ElseIf lPointNumber = 2 Then
            lMax = cAvax1.GetSelectedHandlesArr(h())
            If lMax > 0 Then
                If cAvax1.GetProperties(h(), iType(), vProp(), vData()) = True Then
                    For lCnt = 1 To lMax
                        If iType(lCnt) = Line_i Then
                           xyz() = vData(lCnt)
                           ok = 0
                           jCnt = 1
                           Call oMath.CheckPointOnLine(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), x1(1), y1(1), ok)
                           Call oMath.CheckPointOnLine(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), x1(2), y1(2), ok)
                           If ok = 2 Then
                              Call oMath.LineEquation(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), A, B, C)
                              If IsZero(x1(1) * A + y1(1) * B + C) = True And IsZero(x1(2) * A + y1(2) * B + C) = True Then
                                 Call oMath.Distance(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), dMax)
                                 Call oMath.Distance(xyz(jCnt), xyz(jCnt + 1), x1(1), y1(1), d1)
                                 Call oMath.Distance(x1(2), y1(2), xyz(jCnt + 3), xyz(jCnt + 4), d2)
                                 If d1 + d2 > dMax Then
                                    Call cAvax1.Add_Line(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 2), x1(2), y1(2), xyz(jCnt + 2))
                                    Call cAvax1.Add_Line(x1(1), y1(1), xyz(jCnt + 5), xyz(jCnt + 3), xyz(jCnt + 4), xyz(jCnt + 5))
                                 Else
                                    Call cAvax1.Add_Line(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 2), x1(1), y1(1), xyz(jCnt + 2))
                                    Call cAvax1.Add_Line(x1(2), y1(2), xyz(jCnt + 5), xyz(jCnt + 3), xyz(jCnt + 4), xyz(jCnt + 5))
                                 End If
                                 ToDelH(1) = h(lCnt)
                                 Call cAvax1.DeleteItems(ToDelH())
                              End If
                           End If
                        ElseIf iType(lCnt) = Polyline_i Then
                            xyz() = vData(lCnt)
                            fOk = False
                            ReDim p1x(UBound(xyz()) / 6 + 1) As Single, p1y(UBound(xyz()) / 6 + 1) As Single, p1z(UBound(xyz()) / 6 + 1) As Single
                            ReDim p2x(UBound(xyz()) / 6 + 1) As Single, p2y(UBound(xyz()) / 6 + 1) As Single, p2z(UBound(xyz()) / 6 + 1) As Single
                            For jCnt = 1 To UBound(xyz()) Step 6
                                lCount = lCount + 1
                                p1x(lCount) = xyz(jCnt)
                                p1y(lCount) = xyz(jCnt + 1)
                                p1z(lCount) = xyz(jCnt + 2)
                                p2x(lCount) = xyz(jCnt + 3)
                                p2y(lCount) = xyz(jCnt + 4)
                                p2z(lCount) = xyz(jCnt + 5)
                                If fOk = False Then
                                   Call oMath.CheckPointOnLine(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), x1(1), y1(1), ok)
                                   Call oMath.CheckPointOnLine(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), x1(2), y1(2), ok)
                                   If ok = 2 Then
                                      Call oMath.LineEquation(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), A, B, C)
                                      If IsZero(x1(1) * A + y1(1) * B + C) = True And IsZero(x1(2) * A + y1(2) * B + C) = True Then
                                         fOk = True
                                         Call oMath.Distance(xyz(jCnt), xyz(jCnt + 1), xyz(jCnt + 3), xyz(jCnt + 4), dMax)
                                         Call oMath.Distance(xyz(jCnt), xyz(jCnt + 1), x1(1), y1(1), d1)
                                         Call oMath.Distance(x1(2), y1(2), xyz(jCnt + 3), xyz(jCnt + 4), d2)
                                         If d1 + d2 > dMax Then
                                            p1x(lCount) = xyz(jCnt)
                                            p1y(lCount) = xyz(jCnt + 1)
                                            p1z(lCount) = xyz(jCnt + 2)
                                            p2x(lCount) = x1(2)
                                            p2y(lCount) = y1(2)
                                            p2z(lCount) = xyz(jCnt + 2)
                                            If lCount > 1 Then
                                               ReDim Preserve p1x(lCount) As Single, p1y(lCount) As Single, p1z(lCount) As Single
                                               ReDim Preserve p2x(lCount) As Single, p2y(lCount) As Single, p2z(lCount) As Single
                                               Call cAvax1.Add_BlockLines(p1x(), p1y(), p1z(), p2x(), p2y(), p2z())
                                            Else
                                               Call cAvax1.Add_Line(p1x(1), p1y(1), p1z(1), p2x(1), p2y(1), p2z(1))
                                            End If
                                            ReDim p1x(UBound(xyz()) / 6 + 1) As Single, p1y(UBound(xyz()) / 6 + 1) As Single, p1z(UBound(xyz()) / 6 + 1) As Single
                                            ReDim p2x(UBound(xyz()) / 6 + 1) As Single, p2y(UBound(xyz()) / 6 + 1) As Single, p2z(UBound(xyz()) / 6 + 1) As Single
                                            lCount = 1
                                            p1x(lCount) = x1(1)
                                            p1y(lCount) = y1(1)
                                            p1z(lCount) = xyz(jCnt + 5)
                                            p2x(lCount) = xyz(jCnt + 3)
                                            p2y(lCount) = xyz(jCnt + 4)
                                            p2z(lCount) = xyz(jCnt + 5)
                                         Else
                                            p1x(lCount) = xyz(jCnt)
                                            p1y(lCount) = xyz(jCnt + 1)
                                            p1z(lCount) = xyz(jCnt + 2)
                                            p2x(lCount) = x1(1)
                                            p2y(lCount) = y1(1)
                                            p2z(lCount) = xyz(jCnt + 2)
                                            If lCount > 1 Then
                                               ReDim Preserve p1x(lCount) As Single, p1y(lCount) As Single, p1z(lCount) As Single
                                               ReDim Preserve p2x(lCount) As Single, p2y(lCount) As Single, p2z(lCount) As Single
                                               Call cAvax1.Add_BlockLines(p1x(), p1y(), p1z(), p2x(), p2y(), p2z())
                                            Else
                                               Call cAvax1.Add_Line(p1x(1), p1y(1), p1z(1), p2x(1), p2y(1), p2z(1))
                                            End If
                                            ReDim p1x(UBound(xyz()) / 6 + 1) As Single, p1y(UBound(xyz()) / 6 + 1) As Single, p1z(UBound(xyz()) / 6 + 1) As Single
                                            ReDim p2x(UBound(xyz()) / 6 + 1) As Single, p2y(UBound(xyz()) / 6 + 1) As Single, p2z(UBound(xyz()) / 6 + 1) As Single
                                            lCount = 1
                                            p1x(lCount) = x1(2)
                                            p1y(lCount) = y1(2)
                                            p1z(lCount) = xyz(jCnt + 5)
                                            p2x(lCount) = xyz(jCnt + 3)
                                            p2y(lCount) = xyz(jCnt + 4)
                                            p2z(lCount) = xyz(jCnt + 5)
                                         End If
                                      End If
                                   End If
                                End If
                            Next jCnt
                            If fOk = True Then
                               If lCount > 1 Then
                                  ReDim Preserve p1x(lCount) As Single, p1y(lCount) As Single, p1z(lCount) As Single
                                  ReDim Preserve p2x(lCount) As Single, p2y(lCount) As Single, p2z(lCount) As Single
                                  Call cAvax1.Add_BlockLines(p1x(), p1y(), p1z(), p2x(), p2y(), p2z())
                               Else
                                  Call cAvax1.Add_Line(p1x(1), p1y(1), p1z(1), p2x(1), p2y(1), p2z(1))
                               End If
                               ToDelH(1) = h(lCnt)
                               Call cAvax1.DeleteItems(ToDelH())
                            End If
                        ElseIf iType(lCnt) = Ellipse_i Then
                            xyz() = vData(lCnt)
                            If cAvax1.GetEllipseGeometry(h(lCnt), cx, cy, aR, bR, dAngle) = True Then
                               If aR = bR Then
                                  Call oMath.LineInclination(x1(2), y1(2), cx, cy, Angle1)
                                  Call oMath.LineInclination(x1(1), y1(1), cx, cy, Angle2)
                                  Call oMath.PolarPoint(cx, cy, aR, Angle1, xNew1, yNew1)
                                  Call oMath.PolarPoint(cx, cy, aR, Angle2, xNew2, yNew2)
                                  Call cAvax1.Add_Arc(xNew1, yNew1, 0, xNew2, yNew2, 0, cx, cy, 0)
                                  ToDelH(1) = h(lCnt)
                                  Call cAvax1.DeleteItems(ToDelH())
                               End If
                            End If
                        End If
                    Next lCnt
                    cAvax1.Command = Cancel_c
                End If
            End If
        End If
    End If
End Sub

Function IsZero(A As Single) As Boolean
    If Abs(A) < 0.0001 Then IsZero = True
End Function

Private Sub Command1_Click()
    Dim h() As Long
    Dim lCnt As Long
    Dim lMax As Long
    Dim x() As Single, y() As Single, z() As Single
    lMax = cAvax1.GetSelectedHandlesArr(h())
    If lMax > 0 Then
       Call cAvax1.SelectPoints("My_Trim", 2&, x(), y(), z())
       cAvax1.Command = Nearest_c
    End If
End Sub

Private Sub Form_Load()
    Command1.Caption = "My Trim"
    Set oMath = New cAvaxMath
    Call cAvax1.StartAvax
    cAvax1.Add_Line 0, 0, 0, 10, 10, 0
    cAvax1.Add_Line 0, 10, 0, 10, 0, 0
    cAvax1.Add_Rectangle 0, 0, 10, 10
    cAvax1.Add_Circle 0, 0, 0, 4
    cAvax1.Command = AutoLimits_c
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set oMath = Nothing
    Call cAvax1.EndAvax
End Sub

Athanasios Gardos
Avax-Software.com

Page 1 of 1


Fast Reply

  

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users