[CDR X5-X8] Нужна помощь в создании кода для кнопки макроса

  • Автор темы Автор темы elshad66
  • Дата начала Дата начала
щяс попробую и другие предложенные варианты
 
Код:
Private Sub ComButImportgcode_Click() 'импортирует содержимое
Dim gcode
Dim s
Dim ss
gcode  = CorelScriptTools.GetFileBox("Text file type|*.txt|All file types|*.*", "Please select a file", 0, "default file name")
  Open gcode For Input As #1
  Do While Not EOF(1)
    Line Input #1, s
    ss = ss & Chr(10) & Chr(13) & s
  Loop
  Close #1
  TextCode = ss
End Sub
обратите внимание - Text file type|*.txt - расширение файла для открытия - ТХТ - если вам надо расширение - .gcode - отредактируйте эту строку
gcode = CorelScriptTools.GetFileBox("Text file type|*.gcode|All file types|*.*", "Please select a file", 0, "default file name")
 
при отключении option explicit
при Dim вся строка красная
при вставке ['] перед SETCURFOLDER ошибка
а если удалять ,то там же адрес открываемой папкия
 

Вложения

  • bandicam 2021-07-31 19-03-47-156.jpg
    bandicam 2021-07-31 19-03-47-156.jpg
    265.8 КБ · Просм.: 196
Нетнетнетнет забудьте!
Выше дастин вам готовый код сделал - его и пробуйте
 
  • Спасибо
Реакции: dastin
при нажати ф5 запуска макроса выходит это
перискакивает на другую кнопку
,тхт поменял на gcode.. а вообще нужны 3 вида .gcode .gc .nc
 

Вложения

  • bandicam 2021-07-31 19-15-29-609.jpg
    bandicam 2021-07-31 19-15-29-609.jpg
    240.4 КБ · Просм.: 191
Код:
Private Sub ComButImportgcode_Click() 'импортирует содержимое
Dim gcode
Dim s
Dim ss
gcode  = CorelScriptTools.GetFileBox("Text file type|*.gcode|All file types|*.*", "Please select a file", 0, "default file name")
  Open gcode For Input As #1
  Do While Not EOF(1)
    Line Input #1, s
    ss = ss & Chr(10) & Chr(13) & s
  Loop
  Close #1
  TextCode = ss
End Sub
 
Код:
Private Sub btnFolder_Click() 'импортирует содержимое
Dim gcode
Dim s
Dim ss
gcode  = CorelScriptTools.GetFileBox("Text file type|*.gcode|All file types|*.*", "Please select a file", 0, "default file name")
  Open gcode For Input As #1
  Do While Not EOF(1)
    Line Input #1, s
    ss = ss & Chr(10) & Chr(13) & s
  Loop
  Close #1
  TextCode = ss
End Sub
 
'dans))' отлично работает,,спасибо ,а куда добавить gc .nc, , только gcode видно,
 

Вложения

  • bandicam 2021-07-31 19-34-14-062.jpg
    bandicam 2021-07-31 19-34-14-062.jpg
    392.3 КБ · Просм.: 199
а вообще нужны 3 вида .gcode .gc .nc
gcode = CorelScriptTools.GetFileBox("Text file type|*.gcode|All file types|*.*", "Please select a file", 0, "default file name")
заменить на
gcode = CorelScriptTools.GetFileBox()
покажет в FileBox файлы всех расширений
 
вауу ,

dastin

ты красава оооогромное спасибо оказвычка все было просто ,надо было в том же коде просто поменять
gcode = "C:\CDR2Mill\CDR2Mill.gcode"
на
gcode = CorelScriptTools.GetFileBox()
 
все расширения видны
я
 

Вложения

  • bandicam 2021-07-31 19-45-25-406.jpg
    bandicam 2021-07-31 19-45-25-406.jpg
    392.5 КБ · Просм.: 200
Так оно всегда там было, просто надо было выбирать не Text file type а All file types
 
ну да это вам программистам просто, вы же этим занимаетесь постоянно я, а мне механику в 58 , куда там до скриптов ,
темный лес, '))'
 
появилась одна проблема с этим макросом , не оч важная, ну может и ее плучится решить
это макрос подключаеться к чпу станку через плату ардуино с прошивкой grbl
если код не большой ,строк 500-600 то все ок, а если больше то станок начинает заикаться,
т,е буфер переполняеться, от постоянного потока данных,
есть у меня прога lasergrbl через нее все работает нормально, она синхронизирует передачу данных, т.е после отправки одной строки она получает ответ от станка ,что комманда выполнена ,потом посылает следующюю строку кода,
,,а вот макрос все подряд шлет
,вот весь код может там есть что то что можно подправить
 
этот код из форм
Код:
ption Explicit
Dim TextArr() As String
Dim GRBLAnswerText As String
Public GRBLAnswerFlag As Boolean
Dim str As String
Dim FlagOpenPort As Boolean
Dim FlagPause As Boolean
Dim FlagFirstRun As Boolean
Dim LineRun As Long
Dim PauseTime As Integer
Public PortNum As Integer

Private Sub btnFolder_Click() 'откр папку
  Dim gcode
   Dim s
  Dim ss
   gcode = CorelScriptTools.GetFileBox()
    Open gcode For Input As #1
    Do While Not EOF(1)
    Line Input #1, s
    ss = ss & Chr(10) & Chr(13) & s
  Loop
  Close #1
  TextCode = ss
End Sub



Private Sub CheckBoxSearhPortAuto_Click() 'выбор ручного или авто поиска порта
    If Not CheckBoxSearhPortAuto.Value Then
        ComboBoxPort.Clear              'Очистка комбокса перед заполнением
        ComboBoxPort.Enabled = True
            Dim i As Integer
            Dim p As Long
            
                For i = 1 To 255
                    p = EnumSerPorts(i)
                    If p Then ComboBoxPort.AddItem "COM " & i
                Next
          ComboBoxPort.Text = ComboBoxPort.List(0)
    Else
        ComboBoxPort.Enabled = False
        ComboBoxPort.Text = ""
    End If
End Sub

Private Sub ComboBoxPort_Change()
    
End Sub

Private Sub CommandButton10_Click()
     Send "G91 Y-10"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton14_Click()
    Send "G91 X1"
    Send "G92 X0 Y0"
End Sub

Private Sub CommandButton15_Click()
     Send "G91 X5"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton16_Click()
     Send "G91 X10"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton17_Click()
    Send "G1 F2000"
End Sub
Private Sub CommandButton18_Click()
    Send "$X"
End Sub

Private Sub CommandButton19_Click()
    Send "!"
End Sub
Private Sub CommandButton20_Click()
     Send "Ctrl-x"
End Sub
Private Sub CommandButton21_Click()
     Send "G91 Y1"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton22_Click()
     Send "G91 Y5"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton23_Click()
     Send "G91 Y10"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton24_Click()
     Send "G91 X-10"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton25_Click()
     Send "G91 X-5"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton26_Click()
     Send "G91 X-1"
     Send "G92 X0 Y0"
End Sub

Private Sub CommandButton27_Click()
     Send "G0 X0 Y0"
End Sub
 
Private Sub ComButImportgcode_Click() 'импортирует содержимое
 Dim gcode
 Dim s
 Dim ss
 gcode = "C:\CDR2Mill\CDR2Mill.gcode"
  Open gcode For Input As #1
  Do While Not EOF(1)
    Line Input #1, s
    ss = ss & Chr(10) & Chr(13) & s
  Loop
  Close #1
  TextCode = ss
End Sub

Private Sub CommandButton4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

End Sub
Private Sub CommandButton8_Click()
     Send "G91 Y-1"
     Send "G92 X0 Y0"
End Sub
Private Sub CommandButton9_Click()
     Send "G91 Y-5"
     Send "G92 X0 Y0"
End Sub

Private Sub CommandButtonDisconect_Click()
    If Not FlagOpenPort Then Exit Sub
    MSComm.PortOpen = False
    FlagOpenPort = False
    Label5.Caption = "Порт отключен"
    'UserForm.Caption = "Порт отключен"
    CommandButtonStart.Enabled = False
    CommandButtonPausa.Enabled = False
    CommandButtonStop.Enabled = False
    CommandButtonDisconect.Enabled = False
    CommandButtonConnect.Enabled = True
    CheckBoxSearhPortAuto.Enabled = True
    CommandButtonHome.Enabled = False
End Sub

Private Sub CommandButtonStop_Click()
    Send "!"
End Sub

Private Sub Frame2_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub Label6_Click()

End Sub

Private Sub MSComm_OnComm()
 
   Select Case MSComm.CommEvent
  
          Case comEventBreak   'Получен сигнал Break.
                MsgBox "comEventBreak"
          Case comEventFrame   ' Framing Error ошибка кадрирования
                MsgBox "comEventFrame"
          Case comEventOverrun   ' Data Lost. Потерянные Данные
                MsgBox "comEventOverrun"
          Case comEventRxOver   ' Receive buffer overflow.Переполнение буфера приема.
                MsgBox "comEventRxOver"
          Case comEventRxParity   ' Parity Error.ошибка четности
                MsgBox "comEventRxParity"
          Case comEventTxFull   ' Transmit buffer full.Буфер передачи заполнен.
                MsgBox "comEventTxFull"
          Case comEventDCB   ' Unexpected error retrieving DCB Непредвиденная ошибка при получении DCB
                MsgBox "comEventDCB"
          Case comEvCTS  ' Change in the CTS line.
                MsgBox "comEvCTS"
          Case comEvDSR  ' Change in the DSR line.
                MsgBox "DSR Signal"
          Case comEvReceive   ' Received RThreshold # of chars.  получение текстовых символов
              GRBLAnswerText = MSComm.Input
                        If InStr(GRBLAnswerText, "Grbl") Then
                           GRBLAnswerFlag = True 'Порт подключили и он ответил Grbl
                        Else
                            TextOut.Text = TextOut.Text & GRBLAnswerText ' & vbCrLf
                            TextOut.SetFocus
                            GRBLAnswerText = ""
                            If FlagFirstRun = False And LineRun > 0 Then
                                CommandButtonStart_Click
                            End If
                        End If
    End Select
End Sub

Private Sub CommandButtonHome_Click()
    Send "$H"
    Send "G92 X0 Y0"
End Sub

Private Sub CommandButtonPausa_Click()
'!!!!!!!!!!  Если прошивка меньше 1.1 то при паузе движение будет сразу прекращаться ,
'!!!!!!!!!! а лазер будет оставаться включенным (жеч - светить).
' В прошивке 1.1 , включить $32=1 , тогда при остановке лазер не будет светить.

    FlagPause = FlagPause Xor True

    If FlagPause Then
        CommandButtonPausa.Caption = "Продолжить"
        Send "!"
    Else
        CommandButtonPausa.Caption = "Пауза"
        Send "~"
    End If

End Sub

Private Static Sub CommandButtonStart_Click()
    CommandButtonStart.Enabled = False
    
    If FlagFirstRun Then  ' Первый запуск
        CommandButtonPausa.Enabled = True
        TextArr = Split(TextCode.Text, vbCrLf) 'Получаем массив строк . в TextCode.Text содержиться g code
        LineRun = 0
        FlagFirstRun = False
        TextOut.Text = ""
    End If
        
    If UBound(TextArr) < LineRun Then
        LineRun = 0
        FlagFirstRun = True
        CommandButtonPausa.Enabled = False
        CommandButtonStart.Enabled = True
        Exit Sub
    Else
        TextOut.Text = TextOut.Text & LineRun & " | " & TextArr(LineRun) & " => "
        TextOut.SetFocus
        Send TextArr(LineRun)
        LineRun = LineRun + 1
    End If
End Sub

Private Function Send(ByVal s As String) As Boolean
    'Проверить статус подключен или нет
   ' Обработать исключения разрыва связи
  
    MSComm.Output = s & Chr(10) '& Chr(13)
    Send = True
      
End Function
Private Sub CommandButtonConnect_Click()
    If FlagOpenPort Then Exit Sub
    If CheckBoxSearhPortAuto.Value Then   'авто режим поиска портов
        FlagOpenPort = SearchSerPort(PauseTime) 'Перебор существующих портов , ответят Grbl
        If FlagOpenPort Then
           UserForm.Caption = "Подключили COM " & MSComm.CommPort
           ComboBoxPort.AddItem "COM " & MSComm.CommPort
          
           ComboBoxPort.Text = ComboBoxPort.List(ComboBoxPort.ListCount - 1)
           CheckBoxSearhPortAuto.Enabled = False
           CommandButtonStart.Enabled = True
           CommandButtonDisconect.Enabled = True
           CommandButtonConnect.Enabled = False
           CommandButtonHome.Enabled = True
        Else
            Label5.Caption = "Порт для подключениея не найден"
        End If
    Else    'Ручной режим подключения к выбранному порту
        If ComboBoxPort.Text <> "" Then
        Dim strCom As String
        strCom = Mid(ComboBoxPort.Text, 5) 'Номер порта , от COM 4 отрезаются буквы
            
            FlagOpenPort = PortCom(strCom, PauseTime)  'Попытка подключиться к выбранному порту за  секунды
            If FlagOpenPort Then
               Label5.Caption = "Подключили COM " & MSComm.CommPort
               'UserForm.Caption = "Подключили COM " & MSComm.CommPort
               CheckBoxSearhPortAuto.Enabled = False
               ComboBoxPort.Enabled = False
               CommandButtonStart.Enabled = True
               CommandButtonPausa.Enabled = False
               CommandButtonStop.Enabled = False
               CommandButtonDisconect.Enabled = True
               CommandButtonConnect.Enabled = False
                            
            Else
               Label5.Caption = "Нет подключения к COM " & MSComm.CommPort
            End If
        End If
    End If
End Sub
Private Sub CommandButton4_Click()
If Not FlagOpenPort Then Exit Sub
    If TextCommand.Text = "" Then
    Send "$"
    Else
    Send TextCommand.Text
    End If
End Sub

Private Sub TextCode_Change()
    ' вставить сюда
End Sub

Private Sub TextCommand_Change()

End Sub

Private Sub TextOut_Change()

End Sub

Private Sub UserForm_Activate()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
    ActiveDocument.Unit = cdrMillimeter
      PauseTime = 3000  ' Время ожидания ответа от GRBL , если GRBL не успевает ответить , увеличить время.
      CommandButtonDisconect.Enabled = False
      MSComm.RThreshold = 1 ' включение события comEvReceive
      FlagFirstRun = True
    End Sub
Private Sub UserForm_Terminate()
    If FlagOpenPort Then MSComm.PortOpen = False
End Sub