Посоветуйте мне проблему вне конуса моего создателя конуса - PullRequest
Новая
       14

Посоветуйте мне проблему вне конуса моего создателя конуса

0 голосов
/ 20 января 2019

Я запустил этот код и нажал на ничью. Я обнаружил проблему вне зоны досягаемости, и отладчик выделил мне эту строку Set coneobject = ThisDrawing.ModelSpace.AddCone(conecenter, coneradius, coneheight)

Но для меня это не ошибка. Можете ли вы мне предложить?, пожалуйста?

enter image description here

 Private Sub cmd_draw_Click()
        UserForm1.Hide
        Dim coneangle As Double

        Select Case comboboxangle.Text
            Case 0
                coneangle = 15
            Case 1
                coneangle = 30
            Case 2
                coneangle = 45
            Case 3
                coneangle = 60
        End Select
        Drawcone coneangle
        UserForm1.show

    End Sub

    Public Sub Drawcone(coneangle As Double)
        Dim coneobject As Acad3DSolid
        Dim conecenter As Variant
        Dim coneheight As Double
        'Dim coneangle As Double
        Dim coneradius As Double
        coneheight = UserForm1.TextBox1.Text

        With ThisDrawing.Utility
            conecenter = .GetPoint(, vbCr & "select position for Top of cone:")
        End With

        conecenter(2) = conecenter(2) - coneheight / 2#
        coneradius = coneheight * Tan(coneangle)

        'Set coneobject = ThisDrawing.ModelSpace.AddCone(conecenter, coneradius, coneheight)
        Set coneobject = ThisDrawing.ModelSpace.AddCone(conecenter, coneradius, coneheight)
        coneobject.Update
        ThisDrawing.ChangeViewDirection

    End Sub

    Private Sub cmd_finish_Click()
        Unload Me

    End Sub

    ''Private Sub cmd_pickpoint_Click()
        ''UserForm1.Hide
        ''Dim conecenter As Variant
        'With ThisDrawing.Utility
            'conecenter = .GetPoint(, vbCr & "select position for Top of cone:")
        'End With
        'UserForm1.show

    'End Sub


    Private Sub UserForm_Initialize()

        With comboboxangle
            .AddItem "15"
            .AddItem "30"
            .AddItem "45"
            .AddItem "60"
            .Text = "Empty"
        End With


    End Sub

1 Ответ

0 голосов
/ 20 января 2019

Одной из возможных проблем является использование функции tan: тригонометрические функции, такие как tan, работают с использованием угловых значений, выраженных в радианах , а не в градусах.

Таким образом, вам нужно изменить: 

coneradius = coneheight * Tan(coneangle)

до: 

coneradius = coneheight * Tan(pi * (coneangle / 180#))

Использование градусов не приведет к ошибке функции (поскольку вы по-прежнему вводите числовое значение), но значение будет интерпретировано в радианах, что приведет к неожиданным результатам (например, 15 градусов будет интерпретировано как 15 радиан = 139,4 градуса). ).

...