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
Page 1 of 1
Make your own Trim command
#1
Posted 24 June 2008 - 10:23 AM
VB6 source code on how to make your own Trim command:
Athanasios Gardos
Avax-Software.com
Avax-Software.com
Page 1 of 1
Sign In
Register
Help
Add Reply
MultiQuote