[Igor12345]

Помогите пожалуйста назначить задачи кнопкам на приближение отдаления, сохранения и закрытие чертежа в AutoCad

Код:

[Выделить все]

'*******Процедура открытия чертежа************
Private Sub Command1_Click()
  Label1.Visible = True
  Set acd = CreateObject("autocad.application") 'запускаем AutoCAD
  Set dr = acd.Documents
  dr.Open ("C:\AutoCAD_23\Stanok.dwg")     'открываем чертеж
  acd.Visible = True
  Form1.Caption = "Станок"      'переименовываем главную форму
  Form1.Show
  Form1.Height = 10855            'устанавливаем высоту главной формы
  Frame1.Visible = True  'делаем видимой панель параметров 
  Command1.Enabled = False
End Sub 

'*******Приблизить*************
Private Sub Command24_Click()
   
End Sub
'*******Отдалить*************
Private Sub Command24_Click()
   
End Sub

'*******Сохранить чертеж*************
Private Sub Command24_Click()
   
End Sub

'*******Закрыть программу*************
Private Sub Command25_Click()
Rem acd.Close 'зарываем чертеж
Rem acd.quit
End Sub

[gomer]

Сообщение от hwd acd.SendCommand "_zoom _all "

Код:

[Выделить все]

acd.ZoomAll

вот так кажется проще... И т.д.

[hwd]

Сообщение от gomer Код: [Выделить все] acd.ZoomAll вот так кажется проще... И т.д.

читай концовку поста #18 - это то, о чём я и говорил. У меня сейчас нет под рукой Windows/AutoCAD/IDE, поэтому посмотреть, что там за свойства/методы у VBA я не могу. Это уже удел автора - я указал направление.

[gomer]

Сообщение от Igor12345 почему пользоваться SendCommand крайне нежелательно

медленно и грязно... но иногда жизненно необходимо... ввиду несовершенности COM-модели акада

[Александр Ривилис]

Не

Сообщение от Igor12345 dr.SendCommand ("_qsave _s")

а

Сообщение от Igor12345 dr.SendCommand ("_qsave _s ")

[hwd]

Сообщение от Igor12345 почему пользоваться SendCommand крайне нежелательно

Ты блин когда сообщения правишь, хоть метку об этом делай, или ты думаешь, что твои посты все сидят и ежесекундно сканируют на предмет твоих изменений? Меняешь млин их содержимое со скоростью звука...

Я же писал тебе выше:

поскольку вызывается он асинхронно

А это значит, что к примеру, у тебя написан такой код:

Код:

[Выделить все]

Public Sub Command24_Click()
Form1.Hide
Set dr = acd.ActiveDocument
acd.Visible = True
dr.SendCommand ("_qsave _s")
Form1.Show
End Sub

И ты наверняка думаешь, что твой код dr.SendCommand ("_qsave _s") будет выполнен сразу после строки acd.Visible = True, и только после этого будет выполнена строка Form1.Show... Так? А вот нихрена не так на самом деле... Асинхронно, это значит, что команда, отправленная тобою на консоль автокада (посредством SendCommand) будет выполнена несколько позже, а когда именно - это уже на усмотрение AutoCAD (и тут ты ничего не поделаешь)... Т.е. у тебя нет чёткой уверенности в том, когда будет выполнен SendCommand (однако он однозначно будет выполнен до выхода из метода). Асинхронность - это основной минус SendCommand.

[Олег (jr.)]

Пробуй

Код:

[Выделить все]

 Option Explicit
Dim acd As Object
Dim dr As Object
Dim doc As Object
Dim fname As String

Private Sub Command1_Click()

 Set acd = CreateObject("autocad.application") 'запускаем AutoCAD
 acd.Visible = True
 acd.WindowState = 3

 Set dr = acd.Documents

 fname = "C:\AutoCAD_23\Stanok.dwg"
 Set doc = dr.Open(fname, False)  '<--открываем чертеж для чтения и записи(True - для чтения)

doc.ActiveSpace = 1

Label1.Visible = True
Form1.Caption = "Станок" 'переименовываем главную форму
Command1.Enabled = False
Form1.Height = 1000 ' 10855 'устанавливаем высоту главной формы
Frame1.Visible = True 'делаем видимой панель параметров


End Sub

'*******Приблизить*************
 Private Sub Command22_Click()
 '' 1 method
'Dim cmd As String
'cmd = "_ZOOM A " '<-- equival to "zoomall" method
'doc.SendCommand cmd
'' 2 method
acd.ZoomAll
 End Sub
 '*******Отдалить*************
 Private Sub Command23_Click()
 '' 1 method
'Dim cmd As String
'cmd = "_ZOOM .25 " '<--zoomming percents equival to "zoomscale" method
'doc.SendCommand cmd
'' 2 method
acd.ZoomScaled 0.25, 0
 End Sub
 
'*******Сохранить чертеж*************
 Private Sub Command24_Click()
  '' 1 method
'Dim cmd As String
'cmd = "_QSAVE N " '<--save drawing changes
'doc.SendCommand cmd
'' 2 method
doc.SaveAs (fname)
 End Sub
 
'*******Закрыть программу*************
 Private Sub Command25_Click()
 
 Rem acd.Close 'зарываем чертеж
 Rem acd.quit
 doc.Close
  acd.Quit
    Set doc = Nothing
    Set dr = Nothing
    Set acd = Nothing
    End
 
 End Sub

[gomer]

Сообщение от Олег (jr.) Пробуй

забыл залочить кнопафки... а то ведь обезяна с гранатой может и наплодить акадов

[luka_zluka1]

Помогите написать программу для решения системы трех линейных уравнений ,задаваемых матрицей коэффициентов 3*4 .Значение элементов матрицы должны задаваться вводом с клавиатуры . Расчеты должны быть вынесены в подпрограмму.

[gomer]

Сообщение от luka_zluka1 Помогите написать программу для решения системы трех линейных уравнений

http://www.bestreferat.ru/referat-142855.html

[Vladimir70]

Джентльмены,

Пожалуйста, посоветуйте чем пролечить макрос. Пример хоть и взят из справки, но все равно не работает.
Само VBA запускается из экселя, откуда берет 773 координаты Х и У (в мм).

Но вот в Автокаде чертить их не хочет....

Распечатка ниже.

Код:

[Выделить все]

Dim x(773) As Integer, y(773) As Integer, i As Integer, n As Integer

Sub xls_to_acad()

n = 773

For i = 5 To n
    x(i) = Cells(i, 5).Value
    y(i) = Cells(i, 6).Value
    
Next

Call ExportPoints

End Sub

Sub ExportPoints()
  
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Dim objSheet As Worksheet
  
  Dim vertice(2) As Integer, zer(2) As Integer
  Dim a As AcadLine
  Dim b As AcadCircle
      
  Set objSheet = ThisWorkbook.Sheets(1)
  Set objApp = GetObject(, "AutoCAD.Application")
  Set objDoc = objApp.ActiveDocument
  
  For i = 0 To 2
    zer(i) = 0 'начальная точка отрезка - (0,0,0)
  Next
  vertice(2) = 0 'т.к. чертеж на плоскости, вершина (Х,У,0)
  
  For i = 5 To n
    
    vertice(0) = x(i) 'OX
    vertice(1) = y(i) 'OY
    
'тут то все и останавливается...
    Set a = objDoc.ModelSpace.AddLine(zer, vertice)
    Set b = objDoc.ModelSpace.AddCircle(vertice, 5)
    
  Next
  
  objDoc.Regen acActiveViewport

End Sub

[Кулик Алексей aka kpblc]

Посмотри в справке пример создания Line.
P.S. Попробуй сменить объявления As Integer на As Double.

[Boxa]

Сообщение от Vladimir70 Пример хоть и взят из справки, но все равно не работает.

Вы пишете не совсем правду, этот пример Вы творчески дорабатывали. Причем не разобравшись.
Проблема у Вас с типом данных, ЕМНИП, то координаты задаются типом Double

[Vladimir70]

Алексей, Воха,
Спасибо огромное! Все заработало!

Как раз с типами я был уверен на все 100% - ибо в мм нет величин более 32 тыс.
Увы, я до сих пор не понимаю как VBA работает между приложениями - поэтому и косо смотрел именно на эту часть кода.