Android Question Simple CAD

Terradrones

Active Member
Hi All

I have a very simple CAD routine, where the Surveyor can draw lines, points, arcs, etc. in the Field as he\she records survey points. My problem is that when zooming in or out of the screen, the survey points disappear off the screen after a couple of zooms. How can I make that the center of the screen zooms in or out where my finger touched the screen?

My code:
B4X: 
[/

#Region ********************************************************** CAD *************************************************

Sub OpenCADFile
    If ShowCAD=0 Then
        OpenCAD
        ReadCAD
        ShowCAD=1
        InitDrawing
        Draw(1)
        PlotCAD
    Else
        cvsDrawing.ClearRect(cvsDrawing.TargetRect)
        CADCnt=-1
        InitScale(Scale,0,0)
        Draw(1)
        ShowCAD=0
    End If
End Sub

Sub SaveCADFile
    SaveCAD
End Sub

Sub SaveCAD
    Dim i As Int
    
    OpenCAD
    For i=0 To CADCnt
        Query = "INSERT INTO CadDraw VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
        CGlobals.SQL1.ExecNonQuery2(Query, Array As String(CAD(i).CadType, CAD(i).EastSt, CAD(i).NorthSt, CAD(i).ElevSt,CAD(i).EastEn, CAD(i).NorthEn, CAD(i).ElevEn, CAD(i).Radius, CAD(i).TextStr, CAD(i).TextSize, CAD(i).Color, CAD(i).Layer, "0", CAD(i).IsVisible))
    Next
    CADNotStored=0
    ToastMessageShow("Drawing Saved" , False)
End Sub

Sub RedrawCad
    InitScale(Scale,0,0)
    Draw(1)
    If ShowCAD=1 Then PlotCAD
End Sub

Sub CADColor
    Dim cd As ColorPickerDialog
    
    cd.RGB = Colors.Black
    cd.Show("Select Color", "OK", "Cancel", "", Null)
    BaseColor = cd.RGB
End Sub

#End Region

#Region ********************************************************* Files ********************************************

Sub EraseCADFile
    'Erase Drawing
    Msgbox2Async("This Will Erase Your Existing CAD Drawing" , "Erase CAD", "OK", "Cancel", "", Null,False)
    Wait For Msgbox_Result (Answ As Int)
    If Answ = DialogResponse.POSITIVE Then
        CADCnt=-1
        CGlobals.SQL1.Initialize(File.DirRootExternal  & "/CEASER/DATA/" & CGlobals.Site & "/" & CGlobals.Job & "/", CGlobals.Job & ".sl3", False)

        CGlobals.SQL1.ExecNonQuery("DROP TABLE IF EXISTS CadDraw")
        CGlobals.SQL1.ExecNonQuery("DROP TABLE IF EXISTS Layers")
        OpenLayers
        ReadLayers
        AddLayers(0)
        OpenCAD
        ToastMessageShow("Drawing Erased" , False)
        cvsDrawing.ClearRect(cvsDrawing.TargetRect)
        cvsDrawing.Invalidate
        Draw(1)
    End If
End Sub

#End Region

#Region *********************************************** Text *********************************************************

Sub EditText2_FocusChanged(HasFocus As Boolean)
    If HasFocus =False Then
    Else
        EditText2.SelectAll
    End If
End Sub

Sub ExitText_Click
    Panel4.Visible=True
    Panel5.Visible=False
    Label10.Text=""
    CadType=-1
End Sub

Sub OKText_Click
    Label10.Text="Pos Text"
    Panel4.Visible=True
    Panel5.Visible=False
    CadType=9
End Sub

#End Region

#Region ****************************************************** Initialize *********************************************

Sub InitDrawing
    Dim i As Int
    i=-1
    
    OpenTopo
    Select Case CGlobals.Li
        Case 1
            Dim rs As ResultSet = CGlobals.sql1.ExecQuery("SELECT No ,Date ,Stn ,IH ,Code ,Feature ,Layer ,HAngle,VAngle ,SDist ,THgt ,Easting ,Northing ,Elevation ,Att1 ,SubAtt1 ,Att2 ,SubAtt2 ,Att3 ,SubAtt3 ,Att4 ,SubAtt4 ,Att5 ,SubAtt5 ,Note ,Inst Real From Topo")
        Case 2
            Dim rs As ResultSet = CGlobals.sql1.ExecQuery("SELECT No,Date,BaseID,Code,Feature,Layer,SatNo,PDOP,HDOP,VDOP,Status,AntHgt,Lat,Lon,Hgt,SDy,SDx,SDz,Age,Easting,Northing,Elevation,Att1,Att1,SubAtt1,Att2,SubAtt2,Att3,SubAtt3,Att4,SubAtt4,Att5,SubAtt5,Note,Inst From TopoGPS")
    End Select

    Do While rs.NextRow
        i=i+1
        Pnt(i).Name = rs.GetString("Feature")
        Pnt(i).East = NumberFormat2(rs.GetDouble("Easting"),1,3,3,False)
        Pnt(i).North= NumberFormat2(rs.GetDouble("Northing"),1,3,3,False)
        Pnt(i).Elev = NumberFormat2(rs.GetDouble("Elevation"),1,3,3,False)
    Loop
    PntNbMax=i
    rs.Close
    InitScale(1,0,0)
End Sub

Sub InitScale(B As Double, C As Double, D As Double)
    Dim i As Int
    
    ScreenX0 = 20dip 
    ScreenY0 = 20dip 
    ScreenW = (PnlDrawing.Width/B) - 2 * ScreenX0
    ScreenH = (PnlDrawing.Height/B) - 2 * ScreenY0

    PntMinX = Pnt(0).East
    PntMaxX = Pnt(0).East
    PntMinY = Pnt(0).North
    PntMaxY = Pnt(0).North

    For i = 0 To PntNbMax
        PntMinX = Min(PntMinX, Pnt(i).East)
        PntMaxX = Max(PntMaxX, Pnt(i).East)
        PntMinY = Min(PntMinY, Pnt(i).North)
        PntMaxY = Max(PntMaxY, Pnt(i).North)
    Next
    
    For i=0 To CADCnt
        PntMinX = Min(PntMinX,CAD(i).EastSt)
        PntMaxX = Max(PntMaxX,CAD(i).EastSt)
        PntMinY = Min(PntMinY,CAD(i).NorthSt)
        PntMaxY = Max(PntMaxY,CAD(i).NorthSt)
        If CAD(i).CadType=5 Then
            PntMinX = Min(PntMinX,CAD(i).EastEn)
            PntMaxX = Max(PntMaxX,CAD(i).EastEn)
            PntMinY = Min(PntMinY,CAD(i).NorthEn)
            PntMaxY = Max(PntMaxY,CAD(i).NorthEn)
        End If
    Next

    If PntMaxX - PntMinX=0 Then
        PntMaxX=100
        PntMinX=-100
    End If
    If PntMaxY - PntMinY=0 Then
        PntMaxY=100
        PntMinY=-100
    End If
    
    CalcLimits(Dist, Dist1)
End Sub

Sub CalcLimits(C As Double, D As Double)
    PntMinX = PntMinX - C
    PntMaxX = PntMaxX - C
    PntMinY = PntMinY - D
    PntMaxY = PntMaxY - D
    PntMaxMinX = PntMaxX - PntMinX
    PntMaxMinY = PntMaxY - PntMinY
    PntMeanX = (PntMaxX + PntMinX) / 2
    PntMeanY = (PntMaxY + PntMinY) / 2

    ScaleX = ScreenW / PntMaxMinX
    ScaleY = ScreenH / PntMaxMinY
    
    If ScaleX > ScaleY Then
        ScaleX = ScaleY
        SheetW = PntMaxMinY * ScreenW / ScreenH
        ScaleX = ScaleY
        SheetX0 = PntMeanX - SheetW / 2
        If Scaletype = 1 Then
            SheetY0 = PntMinY
        Else
            SheetY0 = PntMaxY
            ScaleY = -ScaleY
            ScaleX = -ScaleX
        End If
    Else
        SheetX0 = PntMinX
        SheetH = PntMaxMinX * ScreenH / ScreenW
        ScaleY = ScaleX
        If Scaletype = 1 Then
            SheetY0 = PntMeanY - SheetH / 2
        Else
            ScaleY = -ScaleY
            SheetY0 = PntMeanY + SheetH / 2
            'ScaleX = -ScaleX
        End If
    End If
End Sub

#End Region

#Region ************************************************** Draw ***************************************************

Sub Draw(A As Int)
    Dim i As Int
    
    If A=1 Then
        cvsDrawing.ClearRect(cvsDrawing.TargetRect)
    Else
        cvsTemp.ClearRect(cvsTemp.TargetRect)
    End If
        
    If PntNbMax>0 Then
        For i = 0 To PntNbMax 
            DrawPoint(i, Colors.Black, 1, A)
            If ShowFeature.Checked=True Then
                DrawFeatures(i, Colors.Black, 1, A)
            End If
            If ShowElev.Checked=True Then
                DrawElevations(i, Colors.Black, 1, A)
            End If
        Next
        If A=1 Then
            cvsDrawing.Invalidate
        Else
            cvsTemp.Invalidate
        End If
    End If
End Sub

Sub DrawPoint(PntI As Int, Col As Int, LineW As Int, Opt As Int)
    Dim xp, yp As Double
    
    yp = ConvertPhysicToDrawingY(PntI)
    xp = ConvertPhysicToDrawingX(PntI)
    If Opt=1 Then
        cvsDrawing.DrawCircle(xp, yp, 2dip, xui.Color_Black, True, 1dip)
    Else
        cvsTemp.DrawCircle(xp, yp, 2dip, xui.Color_Black, True, 1dip)
    End If
End Sub

Sub DrawFeatures(PntI As Int, Col As Int, LineW As Int, Opt As Int)
    Dim xp, yp As Double
    Private fnt As B4XFont
    
    fnt = xui.CreateDefaultFont(TextSize.SelectedIndex/(Scale/2))
    xp = Round(ConvertPhysicToDrawingX(PntI))
    yp = Round(ConvertPhysicToDrawingY(PntI))
    If Opt=1 Then
        cvsDrawing.DrawText(Pnt(PntI).Name, xp+2dip, yp-1dip, fnt, Col, "LEFT")
    Else
        cvsTemp.DrawText(Pnt(PntI).Name, xp+2dip, yp-1dip, fnt, Col, "LEFT")
    End If
End Sub

Sub DrawElevations(PntI As Int, Col As Int, LineW As Int, Opt As Int)
    Dim xp, yp As Double
    Private fnt As B4XFont
    
    fnt = xui.CreateDefaultFont(TextSize.SelectedIndex/(Scale/2))
    xp = Round(ConvertPhysicToDrawingX(PntI))
    yp = Round(ConvertPhysicToDrawingY(PntI))
    If Opt=1 Then
        cvsDrawing.DrawText(Pnt(PntI).Elev, xp+2dip, yp+12dip, fnt, Col, "LEFT")
    Else
        cvsTemp.DrawText(Pnt(PntI).Elev, xp+2dip, yp-1dip, fnt, Col, "LEFT")
    End If
End Sub

Sub DrawLine(PntI1 As Int, PntI2 As Int, col As Int, LineW As Double)
    X1 = ConvertPhysicToDrawingX(PntI1)
    Y1 = ConvertPhysicToDrawingY(PntI1)
    X2 = ConvertPhysicToDrawingX(PntI2)
    Y2 = ConvertPhysicToDrawingY(PntI2)
    cvsDrawing.DrawLine(X1, Y1, X2 , Y2, col, LineW)
End Sub

#End Region

#Region ******************************************************** Scale Conversions ************************************************

Sub ConvertPhysicToDrawingX(PntI As Int) As Double
    If PntI>-1 Then Return (Pnt(PntI).East - SheetX0) * ScaleX + ScreenX0
End Sub

Sub ConvertPhysicToCADX(A As Double) As Double
    Return (A - SheetX0) * ScaleX + ScreenX0
End Sub

Sub ConvertPhysicToCADY(A As Double) As Double
    Return (A - SheetY0) * ScaleY + ScreenY0
End Sub

Sub ConvertPhysicToDrawingY(PntI As Int) As Double
    If PntI>-1 Then Return (Pnt(PntI).North - SheetY0) * ScaleY + ScreenY0
End Sub

Sub ConvertDrawingToPhysic(X As Double, Y As Double) As Data
    p.East = (X - ScreenX0) / ScaleX + SheetX0
    p.North = (Y - ScreenY0) / ScaleY + SheetY0
    Return p
End Sub

#End Region

#Region ************************************************** Screen Actions ****************************************

Private Sub pnlTemp_Touch (Action As Int, X As Double, Y As Double)
    Select Action
        Case pnlTemp.TOUCH_ACTION_DOWN
            ScreenDown(X,Y)
        Case pnlTemp.TOUCH_ACTION_MOVE
            ScreenMove(X,Y)
        Case pnlTemp.TOUCH_ACTION_UP
            ScreenUp(X,Y)
    End Select
End Sub

Sub ScreenDown(X As Double, Y As Double)
    ConvertDrawingToPhysic(X, Y )    
    Select Case CadType
        Case 3
            'Pan
            cvsDrawing.ClearRect(cvsDrawing.TargetRect)
            X3=p.East
            Y3=p.North
            Dist=0
            Dist1=0
            xx0 = X
            yy0 = Y
        Case 5,6,7
            'Draw A Line; Circle
            If OK=0 Then
                If Checkbox1.Checked=True Then
                    ClosePoint(p.East,p.North)
                    X=ConvertPhysicToCADX(p.East)
                    Y=ConvertPhysicToCADY(p.North)
                    X1=p.East
                    Y1=p.North
                    Z1=SnapZ
                Else
                    X1=p.East
                    Y1=p.North
                    Z1=0
                End If
                xx0 = X
                yy0 = Y
            End If
    End Select
End Sub

Sub ScreenMove(X As Double, Y As Double)
    'cvsTemp.ClearRect(cvsTemp.TargetRect)
    ConvertDrawingToPhysic(X, Y )
    East.Text=NumberFormat2(p.East,1,3,3,False)
    North.Text=NumberFormat2(p.North,1,3,3,False)
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    If CadType=0 Or CadType>3 Then
        cvsTemp.DrawLine(X, Y-25dip, X , Y+25dip, Colors.Red, 2)
        cvsTemp.DrawLine(X-25dip, Y, X+25dip, Y, Colors.Red, 2)
        cvsTemp.Invalidate
    End If
    If Checkbox1.Checked=True And CadType>4 Then
        ClosePoint(p.East,p.North)
        X=ConvertPhysicToCADX(p.East)
        Y=ConvertPhysicToCADY(p.North)
        cvsTemp.DrawCircle(X, Y, 5dip, Colors.Red, False,1dip)
    End If
    Select Case CadType
        Case 3
            'Pan
            Dist = Floor(p.East-X3)
            Dist1 = Floor(p.North -Y3)
            PlotPanCAD
        Case 4
            'Point
            cvsTemp.DrawCircle(X,Y,2dip,xui.Color_Black,True,1dip)
        Case 5,6
            'Line; Polyline
            xx1 = X
            yy1 = Y
            cvsTemp.DrawLine(xx0, yy0, xx1, yy1, xui.Color_Black, 1dip)
        Case 7
            'Circle
            Radius=Sqrt((X-xx0)*(X-xx0)+(Y-yy0)*(Y-yy0))
            cvsTemp.DrawCircle(xx0, yy0, Radius, xui.Color_Black, False,1dip)
        Case 9
            'Text
            Private fnt As B4XFont
            fnt = xui.CreateDefaultFont(TextSize.SelectedIndex/(Scale/2))
            cvsTemp.DrawText(EditText2.Text, X, Y, fnt, BaseColor, "LEFT")
    End Select
    cvsTemp.Invalidate
End Sub

Sub ScreenUp(X As Double, Y As Double)
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    ConvertDrawingToPhysic(X, Y )
    ShowCAD=1
    Select Case CadType
        Case 1
            'Zoom In
            If Scale>0.1 Then Scale=Scale-0.05
            RedrawCad
        Case 2
            'Zoom Out
            Scale=Scale+0.05
            RedrawCad
        Case 3
            'Pan
            Draw(1)
            PlotCAD
        Case 4
            'Plot A Point
            If Checkbox1.Checked=True Then
                ClosePoint(p.East,p.North)
                X=ConvertPhysicToCADX(p.East)
                Y=ConvertPhysicToCADY(p.North)
                X1=p.East
                Y1=p.North
                Z1=SnapZ
            Else
                X1=p.East
                Y1=p.North
                Z1=0
            End If
            cvsDrawing.DrawCircle(X,Y,2dip,BaseColor,True,1dip)
            SaveTempCAD(4)
        Case 5,6
            'Line; Polyline
            If Checkbox1.Checked=True Then
                ClosePoint(p.East,p.North)
                X=ConvertPhysicToCADX(p.East)
                Y=ConvertPhysicToCADY(p.North)
                X2=p.East
                Y2=p.North
                Z2=SnapZ
            Else
                X2=p.East
                Y2=p.North
                Z2=0
            End If
            xx1=X
            yy1=Y
            cvsDrawing.DrawLine(xx0, yy0, xx1, yy1,BaseColor, 1dip)
            SaveTempCAD(5)
            If CadType=6 Then
                OK=1
                X1=X2
                Y1=Y2
                xx0=X
                yy0=y
            End If
        Case 7
            'Circle
            Radius=Sqrt((X-xx0)*(X-xx0)+(Y-yy0)*(Y-yy0))
            cvsDrawing.DrawCircle(xx0, yy0, Radius, BaseColor, False,1dip)
            SaveTempCAD(7)
        Case 8
            'Arc
            If Checkbox1.Checked=True Then
                ClosePoint(p.East,p.North)
                X2=p.East
                Y2=p.North
                Z2=SnapZ
            Else
                X2=p.East
                Y2=p.North
                Z2=0
            End If
            PSX(ArcCad) = X2
            PSY(ArcCad) = Y2
            ArcCad=ArcCad+1
            Select Case ArcCad
                Case 1
                    xx0=ConvertPhysicToCADX(X2)
                    yy0=ConvertPhysicToCADY(Y2)
                    cvsTemp.DrawCircle(xx0, yy0, 5dip, xui.Color_Red, True, 1dip)
                Case 2
                    xx1=ConvertPhysicToCADX(X2)
                    yy1=ConvertPhysicToCADY(Y2)
                    cvsTemp.DrawCircle(xx1, yy1, 5dip, xui.Color_Red, True, 1dip)
                Case 3
                    xx2=ConvertPhysicToCADX(X2)
                    yy2=ConvertPhysicToCADY(Y2)
                    cvsTemp.DrawCircle(xx2, yy2, 5dip, xui.Color_Red, True, 1dip)
                    CalculateCircle(1)
                    ArcCad=0
            End Select
        Case 9
            'Text
            If Checkbox1.Checked=True Then
                ClosePoint(p.East,p.North)
                X=ConvertPhysicToCADX(p.East)
                Y=ConvertPhysicToCADY(p.North)
                X2=p.East
                Y2=p.North
                Z2=SnapZ
            Else
                X2=p.East
                Y2=p.North
                Z2=0
            End If
            Private fnt As B4XFont
            fnt = xui.CreateDefaultFont(TextSize.SelectedIndex/(Scale/2))
            cvsDrawing.DrawText(EditText2.Text, X, Y, fnt, BaseColor, "LEFT")
            ConvertDrawingToPhysic(X , Y)
            SaveTempCAD(9)
            CadType=-1
            Label10.Text=""
        Case 30
            'Display Topo Coords
            CloseTopo(p.East,p.North)
            ShowInfo
    End Select
    cvsDrawing.Invalidate
    cvsTemp.Invalidate
End Sub

#End Region

#Region ********************************************************** CAD Actions *****************************************

Sub SaveTempCAD(A As Int)
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    cvsTemp.Invalidate
    CADCnt=CADCnt+1
    CAD(CADCnt).Radius=0
    CAD(CADCnt).TextStr=0
    CAD(CADCnt).TextSize=0
    CAD(CADCnt).Color=BaseColor
    CAD(CADCnt).Layer=SelectedCADLayer    
    CAD(CADCnt).IsVisible=1
    CADNotStored = 1
    Select Case A
        Case 4
            'Point
            CAD(CADCnt).CadType=4
            CAD(CADCnt).EastSt = NumberFormat2(X1,1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(Y1,1,3,3,False)
            CAD(CADCnt).ElevSt = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).EastEn = 0
            CAD(CADCnt).NorthEn = 0
            CAD(CADCnt).ElevEn = 0
        Case 5
            'Line
            CAD(CADCnt).CadType=5
            CAD(CADCnt).EastSt = NumberFormat2(X1,1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(Y1,1,3,3,False)
            CAD(CADCnt).ElevSt = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).EastEn = NumberFormat2(X2,1,3,3,False)
            CAD(CADCnt).NorthEn = NumberFormat2(Y2,1,3,3,False)
            CAD(CADCnt).ElevEn = NumberFormat2(0,1,3,3,False)
        Case 7
            'Circle
            CAD(CADCnt).CadType=7
            CAD(CADCnt).EastSt = NumberFormat2(X1,1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(Y1,1,3,3,False)
            CAD(CADCnt).ElevSt = 0
            CAD(CADCnt).EastEn = 0
            CAD(CADCnt).NorthEn = 0
            CAD(CADCnt).ElevEn = 0
            CAD(CADCnt).Radius=Radius
        Case 8
            'Arc
            CAD(CADCnt).CadType=8
            CAD(CADCnt).EastSt = NumberFormat2(CenterX,1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(CenterY,1,3,3,False)
            CAD(CADCnt).ElevSt = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).EastEn = NumberFormat2(Phy0,1,3,3,False)
            CAD(CADCnt).NorthEn = NumberFormat2(Phy2,1,3,3,False)
            CAD(CADCnt).ElevEn = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).Radius=Radius
        Case 9
            'Text
            CAD(CADCnt).CadType=9
            CAD(CADCnt).EastSt = NumberFormat2(p.East,1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(p.North,1,3,3,False)
            CAD(CADCnt).ElevSt = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).EastEn = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).NorthEn = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).ElevEn = NumberFormat2(0,1,3,3,False)
            CAD(CADCnt).TextStr=EditText2.Text
            CAD(CADCnt).TextSize=FontSize.SelectedIndex
    End Select
End Sub

Sub OpenCAD
    Dim Query As String

    Try
        If File.Exists(File.DirRootExternal  & "/CEASER/DATA/" & CGlobals.Site & "/" & CGlobals.Job & "/", CGlobals.Job & ".sl3") = False Then
            File.MakeDir(File.DirRootExternal & "/CEASER/DATA/" & CGlobals.Site & "/", CGlobals.Job & ".sl3")
        Else
            CGlobals.SQL1.Initialize(File.DirRootExternal  & "/CEASER/DATA/" & CGlobals.Site & "/" & CGlobals.Job & "/", CGlobals.Job & ".sl3", False)
        End If
        CGlobals.SQL1.Initialize(File.DirRootExternal  & "/CEASER/DATA/" & CGlobals.Site & "/" & CGlobals.Job & "/", CGlobals.Job & ".sl3", False)

        CGlobals.SQL1.Initialize(File.DirRootExternal  & "/CEASER/DATA/" & CGlobals.Site & "/" & CGlobals.Job & "/", CGlobals.Job & ".sl3", False)
        Query = "CREATE TABLE IF NOT EXISTS CadDraw (Entity Text, EastSt Real, NorthSt Real, ElevSt Real, EastEn Real, NorthEn Real, ElevEn Real, Radius Real, TextStr Text, TextSize Real, Color Real, Layer Text, LineType Real, IsVisible Real);"
        CGlobals.SQL1.ExecNonQuery(Query)
    Catch
        CGlobals.SQL1.ExecNonQuery("DROP TABLE IF EXISTS CadDraw")
        Query = "CREATE TABLE IF NOT EXISTS CadDraw (Entity Text, EastSt Real, NorthSt Real, ElevSt Real, EastEn Real, NorthEn Real, ElevEn Real, Radius Real, TextStr Text, TextSize Real, Color Real, Layer Text, LineType Real, IsVisible Real);"
        CGlobals.SQL1.ExecNonQuery(Query)
    End Try
End Sub

Sub ReadCAD
    CADCnt=-1

    ResultSet = CGlobals.sql1.ExecQuery("SELECT Entity, EastSt, NorthSt, ElevSt, EastEn, NorthEn, ElevEn, Radius, TextStr, TextSize, Color, Layer, LineType, IsVisible From CadDraw")

    Try
        Do While ResultSet.NextRow
            CADCnt=CADCnt+1
            CAD(CADCnt).CadType=ResultSet.GetString("Entity")
            CAD(CADCnt).EastSt = NumberFormat2(ResultSet.GetDouble("EastSt"),1,3,3,False)
            CAD(CADCnt).NorthSt = NumberFormat2(ResultSet.GetDouble("NorthSt"),1,3,3,False)
            CAD(CADCnt).ElevSt = NumberFormat2(ResultSet.GetDouble("ElevSt"),1,3,3,False)
            CAD(CADCnt).EastEn = NumberFormat2(ResultSet.GetDouble("EastEn"),1,3,3,False)
            CAD(CADCnt).NorthEn = NumberFormat2(ResultSet.GetDouble("NorthEn"),1,3,3,False)
            CAD(CADCnt).ElevEn = NumberFormat2(ResultSet.GetDouble("ElevEn"),1,3,3,False)
            CAD(CADCnt).Radius = NumberFormat2(ResultSet.GetDouble("Radius"),1,3,3,False)
            CAD(CADCnt).TextStr = ResultSet.GetString("TextStr")
            CAD(CADCnt).TextSize=ResultSet.GetString("TextSize")
            If ResultSet.GetString("Color")=Null Then
                CAD(CADCnt).Color=Colors.Black
            Else
                CAD(CADCnt).Color=ResultSet.GetDouble("Color")
            End If
            CAD(CADCnt).Layer=ResultSet.GetString("Layer")
            CAD(CADCnt).IsVisible=ResultSet.GetString("IsVisible")
        Loop
        ResultSet.close
    Catch
        Log(LastException)
    End Try
End Sub

Sub PlotPanCAD
    Dim i As Int
    
    CalcLimits(Dist, Dist1)
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    cvsDrawing.ClearRect(cvsDrawing.TargetRect)
    
    'Plot the Topo
    If PntNbMax>0 Then
        For i = 0 To PntNbMax
            DrawPoint(i, Colors.Black, 1, 2)
            If ShowFeature.Checked=True Then
                DrawFeatures(i, Colors.Black, 1, 2)
            End If
            If ShowElev.Checked=True Then
                DrawElevations(i, Colors.Black, 1, 2)
            End If
        Next
        cvsTemp.Invalidate
    End If
    PlotCAD
End Sub

Sub PlotCAD
    Dim i As Int
    
    For i=0 To CADCnt
        Try
            If CAD(i).IsVisible=1 Then
                If CAD(i).CadType=4 Then
                    'Point
                    X1 = Round(ConvertPhysicToCADX(CAD(i).EastSt))
                    Y1 = Round(ConvertPhysicToCADY(CAD(i).NorthSt))
                    cvsDrawing.DrawCircle(X1, Y1, 2dip, CAD(i).Color, True, 1dip)
                Else If CAD(i).CadType=5 Then
                    'Line
                    X1 = Round(ConvertPhysicToCADX(CAD(i).EastSt))
                    Y1 = Round(ConvertPhysicToCADY(CAD(i).NorthSt))
                    X2 = Round(ConvertPhysicToCADX(CAD(i).EastEn))
                    Y2 = Round(ConvertPhysicToCADY(CAD(i).NorthEn))
                    cvsDrawing.DrawLine(X1, Y1, X2, Y2, CAD(i).Color, 1dip)
                Else If CAD(i).CadType=7 Then
                    'Circle
                    X1 = Round(ConvertPhysicToCADX(CAD(i).EastSt))
                    Y1 = Round(ConvertPhysicToCADY(CAD(i).NorthSt))
                    Radius=CAD(i).Radius
                    cvsDrawing.DrawCircle(X1, Y1, Radius, CAD(i).Color,False, 1dip)
                Else If CAD(i).CadType=8 Then
                    'Arc
                    CenterX=Round(ConvertPhysicToCADX(CAD(i).EastSt))
                    CenterY=Round(ConvertPhysicToCADY(CAD(i).NorthSt))
                    Phy0=CAD(i).EastEn
                    Phy2=CAD(i).NorthEn
                    Radius=CAD(i).Radius
                    BaseColor=CAD(i).Color
                    DrawArc(cvsDrawing, CenterX,CenterY, Radius, Phy0, Phy2, BaseColor, 1dip,0)
                    'CalculateArc(0)
                Else If CAD(i).CadType=9 Then
                    'Text
                    Private fnt As B4XFont
    
                    fnt = xui.CreateDefaultFont(TextSize.SelectedIndex/(Scale/2))
                    X1 = Round(ConvertPhysicToCADX(CAD(i).EastSt))
                    Y1 = Round(ConvertPhysicToCADY(CAD(i).NorthSt))
                    cvsDrawing.DrawText(CAD(i).TextStr, X1, Y1, fnt,CAD(i).Color, "LEFT")
                End If
            End If
        Catch
            Log(LastException)
        End Try
    Next
    cvsDrawing.Invalidate
End Sub

Sub TextSize_SelectedIndexChanged (Index As Int)
    Draw(1)
    PlotCAD
End Sub

Sub ShowFeature_CheckedChange(Checked As Boolean)
    Draw(1)
    PlotCAD
End Sub

Sub ShowElev_CheckedChange(Checked As Boolean)
    Draw(1)
    PlotCAD
End Sub

#End Region

#Region ************************************************************* CAD Calcs ***************************************

Sub ClosePoint(A As Double, A1 As Double)' As Data
    'Find a Close Point
    Dim i As Int
    Dim Td,Tx As Double
    Dim Mx,My As Double
    
    Td=99999999
    P1=-1
    SnapZ=0
    
    If SnapPoint(0)=1 Then        'Snap to Topo
        For i = 0 To PntNbMax
            Tx= Power(Pnt(i).East-A,2) + Power(Pnt(i).North -A1,2)
            If Tx<Td Then
                Td=Tx
                p.East=Pnt(i).East
                p.North=Pnt(i).North
                SnapZ=NumberFormat2(Pnt(i).Elev,1,3,3,False)
            End If
        Next
    End If
    
    For i=0 To CADCnt
        If (SnapPoint(1)=1 And CAD(i).CadType=4) Or (SnapPoint(4)=1 And CAD(i).CadType=7) Then
            'Point, Circle
            Tx= Power(CAD(i).EastSt-A,2) + Power(CAD(i).NorthSt -A1,2)
            If Tx<Td Then
                Td=Tx
                p.East=CAD(i).EastSt
                p.North=CAD(i).NorthSt
                SnapZ=NumberFormat2(CAD(i).ElevSt,1,3,3,False)
            End If
        Else If SnapPoint(2)=1 And CAD(i).CadType=5 Then
            'Line
            Tx= Power(CAD(i).EastSt-A,2) + Power(CAD(i).NorthSt -A1,2)
            If Tx<Td Then
                Td=Tx
                p.East=CAD(i).EastSt
                p.North=CAD(i).NorthSt
                SnapZ=NumberFormat2(CAD(i).ElevSt,1,3,3,False)
            End If
            Tx= Power(CAD(i).EastEn-A,2) + Power(CAD(i).NorthEn -A1,2)
            If Tx<Td Then
                Td=Tx
                p.East=CAD(i).EastEn
                p.North=CAD(i).NorthEn
                SnapZ=NumberFormat2(CAD(i).ElevEn,1,3,3,False)
            End If
        Else If SnapPoint(3)=1 And CAD(i).CadType=5 Then
            'Mid Line
            Mx=(CAD(i).EastSt + CAD(i).EastEn)/2
            My=(CAD(i).NorthSt + CAD(i).NorthEn)/2
            Tx= Power(Mx-A,2) + Power(My -A1,2)
            If Tx<Td Then
                Td=Tx
                p.East=Mx
                p.North=My
                SnapZ=NumberFormat2((CAD(i).ElevSt + CAD(i).ElevEn)/2,1,3,3,False)
            End If
        End If
    Next
End Sub

Sub CalculateCircle(A As Int)
    'Source of the code
    'https://www.geeksforgeeks.org/equation-of-circle-when-three-points-on-the-circle-are-given/
    Private X1, X2, X3, Y1, Y2, Y3 As Double
    Private x12, x13, y12, y13, y31, y21, x31, x21 As Double
    Private sx13, sy13,sx21, sy21 As Double
    Private f, g, c, sqr_of_r As Double
    Dim spx0, spy0, spx2, spy2 As Double
    
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    
    X1 = PSX(0)
    X2 = PSX(1)
    X3 = PSX(2)
    Y1 = PSY(0)
    Y2 = PSY(1)
    Y3 = PSY(2)
    
    x12 = X1 - X2
    x13 = X1 - X3
 
    y12 = Y1 - Y2
    y13 = Y1 - Y3
 
    y31 = Y3 - Y1
    y21 = Y2 - Y1
 
    x31 = X3 - X1
    x21 = X2 - X1
 
    '   // x1^2 - x3^2
    sx13 = Power(X1, 2) - Power(X3, 2)
    sy13 = Power(Y1, 2) - Power(Y3, 2)
 
    sx21 = Power(X2, 2) - Power(X1, 2)
    sy21 = Power(Y2, 2) - Power(Y1, 2)
 
    f = ((sx13) * (x12) + (sy13) * (x12) + (sx21) * (x13) + (sy21) * (x13)) / (2 * ((y31) * (x12) - (y21) * (x13)))
    g = ((sx13) * (y12) + (sy13) * (y12) + (sx21) * (y13) + (sy21) * (y13)) / (2 * ((x31) * (y12) - (x21) * (y13)))
 
    c = -Power(X1, 2) - Power(Y1, 2) - 2 * g * X1 - 2 * f * Y1
 
    '    // eqn of circle be x^2 + y^2 + 2*g*x + 2*f*y + c = 0
    '    // where centre Is (h = -g, k = -f) And Radius r
    '    // As r^2 = h^2 + k^2 - c
    CenterX = -g
    CenterY = -f
    sqr_of_r = CenterX * CenterX + CenterY * CenterY - c
 
    Radius = Sqrt(sqr_of_r)
    
    Phy0 = ATan2D(PSY(0) - CenterY, PSX(0) - CenterX)
    Phy2 = ATan2D(PSY(2) - CenterY, PSX(2) - CenterX)

    scx = ConvertPhysicToCADX(CenterX)
    scy = ConvertPhysicToCADY(CenterY)
    scr = Radius * Scale
    'DrawCross(cvsTemp, scx, scy, xui.Color_RGB(0, 150, 0))
'    cvsTemp.DrawCircle(scx, scy, scr, xui.Color_RGB(0, 150, 0), False, 1dip)
    
    spx0 = ConvertPhysicToCADX(PSX(0))
    spy0 = ConvertPhysicToCADY(PSY(0))
    spx2 = ConvertPhysicToCADX(PSX(2))
    spy2 = ConvertPhysicToCADY(PSY(2))
'    cvsTemp.DrawLine(spx0, spy0, scx, scy, xui.Color_RGB(0, 150, 0), 1dip)
'    cvsTemp.DrawLine(spx2, spy2, scx, scy, xui.Color_RGB(0, 150, 0), 1dip)
    Radius=Sqrt(Power(spx0-scx,2) +Power(spy0-scy,2))
    CalculateArc(A)
End Sub

Private Sub CalculateArc(A As Int)
    Private a0, a1, a2 As Double
    
    scx = ConvertPhysicToCADX(CenterX)
    scy = ConvertPhysicToCADY(CenterY)
    scr = Radius * Scale
    
    a0 = ATan2D(PSY(0) - CenterY, PSX(0) - CenterX)
    a1 = ATan2D(PSY(1) - CenterY, PSX(1) - CenterX)
    a2 = ATan2D(PSY(2) - CenterY, PSX(2) - CenterX)
    If a0 < 0 Then
        a0 = 360 + a0
    End If
    If a1 < 0 Then
        a1 = 360 + a1
    End If
    If a2 < 0 Then
        a2 = 360 + a2
    End If
    Phy0 = Min(a0, a2)
    Phy2 = Max(a0, a2)
    If a1 < Phy0 Or a1 > Phy2 Then
        Phy2 = Phy2 - 360
    End If
    
    DrawArc(cvsDrawing, scx, scy, scr, Phy0, Phy2, BaseColor, 1dip,A)
End Sub

Sub DrawArc(cvs As B4XCanvas, xcx As Int, xcy As Int, R As Int, AngleStart As Int, AngleEnd As Int, Col As Double, StrokeWidth As Int, A1 As Int)
    Private a, da As Double
    Private n, R1 As Int
    
    cvsTemp.ClearRect(cvsTemp.TargetRect)
    da = 0.5 * (AngleEnd - AngleStart) / Abs(AngleEnd - AngleStart)
    n = (AngleEnd - AngleStart) / da
    a = AngleStart

    If Scale>=1 Then
        R1= R/(1 + (Scale - 1))
    Else
        R1= R/(1 + (1-Scale))
    End If

    X1 = xcx + CosD(a) * R1' * Scale
    Y1 = xcy - SinD(a) * R1' * Scale
    For i = 1 To n
        a = a + da
        X2 = xcx + CosD(a) * R1' * Scale
        Y2 = xcy - SinD(a) * R1' * Scale
        cvsDrawing.DrawLine(X1, Y1, X2, Y2, Col, StrokeWidth)
        X1 = X2
        Y1 = Y2
    Next
    X2 = xcx + CosD(AngleEnd) * R1' * Scale
    Y2 = xcy - SinD(AngleEnd) * R1' * Scale
    cvsDrawing.DrawLine(X1, Y1, X2, Y2, Col, StrokeWidth)
    cvsDrawing.Invalidate
    If A1=1 Then
        SaveTempCAD(8)
    End If
End Sub

#End Region

]
 
Sort by date Sort by votes

amorosik

Expert
Licensed User

The project you show is very interesting
May I ask if you have made any progress since last time?
 
Upvote 0

Terradrones

Active Member
Hi Amorosik, with the help of the people on the Forum (Klaus), I have made changes to the CAD module and also added new functions. The CAD forms part of the Topo module that when the Surveyor does a Topo Survey in the Field he\she can complete much of the drawing in the Field. The drawing can be exported to a DXF format.
 
Upvote 0
You must log in or register to reply here.

Similar Threads

  • Question
Android Question Close Points
Replies
9
Views
1K
emexes
E
  • Question
Android Question Duplicate Project
Replies
14
Views
1K
Shelby
  • Question
Android Question Arc Through 3 Points
Replies
12
Views
997
Terradrones
  • Article
Share My Creation Easy CAD Dimensions
Replies
10
Views
3K
f0raster0
  • Article
Share My Creation Easy cad dimensions
Replies
7
Views
4K
hookshy
Menu
Log in
Register
Cookies are required to use this site. You must accept them to continue using the site. Learn more…