[meugen]

мне нужно кликнуть мышкой по 3d модели, и сделать её копию. проблема в том что я просто немогу выбрать модель и дать ей имя чтобы дальше с ней производить действия. с созданной моделью всё понятно, а выброной нет.
вринципе былобы не плохо еслиб ктонибудь подсказал книгу или сайт с описанием синтаксиса VBA.

[Олег (jr.)]

Сообщение от meugen мне нужно кликнуть мышкой по 3d модели, и сделать её копию. проблема в том что я просто немогу выбрать модель и дать ей имя чтобы дальше с ней производить действия. с созданной моделью всё понятно, а выброной нет. вринципе былобы не плохо еслиб ктонибудь подсказал книгу или сайт с описанием синтаксиса VBA.

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

Тем не менее для примера два способа выбора определенного
типа объектов

Код:

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

Option Explicit
Sub SelSetExample1()
Dim pickPt As Variant
Dim oEnt As AcadEntity
Dim oSolid As Acad3DSolid
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue

pickPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Укажите точку на ребре тела >>")

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("TestSset")
          End With
          
          ftype(0) = 0: fdata(0) = "3DSOLID"
          
oSset.SelectAtPoint pickPt, ftype, fdata

     MsgBox "Выбран(о): " & oSset.Count & " объект(ов)"
     
     If oSset.Count <> 1 Then
     Exit Sub
     End If
     
     Set oEnt = oSset.Item(0)
     If Not oEnt Is Nothing Then
     Set oSolid = oEnt
     MsgBox "Объем тела: " & oSolid.Volume & " об. единиц черчения"
     End If
  
End Sub


Sub SelSetExample2()

Dim oEnt As AcadEntity
Dim oSolid As Acad3DSolid
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("TestSset")
          End With
          
          ftype(0) = 0: fdata(0) = "3DSOLID"
          
oSset.SelectOnScreen ftype, fdata

     MsgBox "Выбран(о): " & oSset.Count & " объект(ов)"
     
     If oSset.Count <> 1 Then
     Exit Sub
     End If
     
     Set oEnt = oSset.Item(0)
     If Not oEnt Is Nothing Then
     Set oSolid = oEnt
     MsgBox "Объем тела: " & oSolid.Volume & " об. единиц черчения"
     End If
  
End Sub

~'J'~

[meugen]

трижди спасибо! Нет четырижды Спасибо! второй код встал как радной, но, я так и не понял как всё это происходит, к примеру ".Item(0).Delete" почему наченается на точку. всётаки нехвотает хорошей книги с подробным описанием синтаксиса. Я вынужден учит его, ксажелению!

А вот ещё вопросик. в моей порге я использую код "Set BKS1 = ThisDrawing.UserCoordinateSystems.Add(p1, X, Y, "New_BKS_Muhl")" чтобы переместить координатную систему в нужную точку. всё работает но мне не нужно имя "New_BKS_Muhl" какбы изменить этот код чтобы не создовалос имя.

[Олег (jr.)]

Сообщение от meugen я так и не понял как всё это происходит, к примеру ".Item(0).Delete" почему наченается на точку. всётаки нехвотает хорошей книги с подробным описанием синтаксиса. Я вынужден учит его, ксажелению!

Точка пишется для сокращения повторений записи в тексте кода
Например, вместо такой записи:

Код:

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

ThisDrawing.ActiveLayout.Block.AddCircle point1, radius1
ThisDrawing.ActiveLayout.Block.AddCircle point2, radius2
ThisDrawing.ActiveLayout.Block.AddCircle point3, radius3

Можно использовать блок кода:
With ... End With

Код:

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

With ThisDrawing.ActiveLayout.Block
.AddCircle point1, radius1
.AddCircle point2, radius2
.AddCircle point3, radius3
End With

Чтобы не создавать новую систему координат лучше использовать
функцию TranslateCoordinates
для объекта ThisDrawing.Utility
Смотри Help файл (жми F1 в редакторе VBA)

~'J'~

[meugen]

Спaсибо, помоему разобрался! Нашел на вашем сайте много ссылок, чему очен рад! но ненашел ответа на главний вопрос, может-ли автокад рисовать плоские фигуры в 3D без пересчета?

[Олег (jr.)]

Сообщение от meugen о ненашел ответа на главний вопрос, может-ли автокад рисовать плоские фигуры в 3D без пересчета?

Пробуй

Код:

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

Sub CopySolidExample1()
Dim pickPt As Variant
Dim newPt As Variant
Dim oEnt As AcadEntity
Dim oSolid As Acad3DSolid
Dim newSolid As Acad3DSolid
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue

With ThisDrawing

.SetVariable "OSMODE", 1

pickPt = .Utility.GetPoint(, vbCrLf & "Укажите точку на углу ребрa тела >>")

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("TestSset")
          End With
          
          ftype(0) = 0: fdata(0) = "3DSOLID"
          
oSset.SelectAtPoint pickPt, ftype, fdata

     If oSset.Count <> 1 Then
     MsgBox "Выбрано больше одного объекта, повторите в другой точке"
     Exit Sub
     End If
     
     Set oEnt = oSset.Item(0)
     If Not oEnt Is Nothing Then
     Set oSolid = oEnt
     newPt = .Utility.GetPoint(pickPt, vbCrLf & "Укажите точку вставки копии >>")
     Set newSolid = oSolid.Copy
     newSolid.Move pickPt, newPt
     End If

  End With ''//ThisDrawing

End Sub

~'J'~

[AnTe]

немного не в тему, но

Сообщение от Олег (jr.) поскольку в последующих версиях Автокада не будет поддержки VBA

откуда эта информация? Насколько она достоверна?

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

Сообщение от AnTe Насколько она достоверна?

Достоверна насколько это возможно: http://usa.autodesk.com/adsk/servlet...70215#section1

[sbi]

AnTe Олег (jr.) немного сгустил краски. По ссылки маэстро в 2010 и 2011 можно работать в VBA. Но, и это очевидно, нужен переход на net .

[meugen]

Спасибо за код, но ресует толко в WKS, а я имел ввиду в BKS.

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

WKS, BKS - это что такое?

[meugen]

простите у меня немецкий AutoCAD, это координатние системы , как по англиски не знаю.
я решил этупроблему так, нарисовал линии в 3D, создал полигон а из полигона выдавил обьект. но как я понимаю это кривое решение.

[Олег (jr.)]

Сообщение от meugen простите у меня немецкий AutoCAD, это координатние системы , как по англиски не знаю. я решил этупроблему так, нарисовал линии в 3D, создал полигон а из полигона выдавил обьект. но как я понимаю это кривое решение.

Смотри в справке TranslateCoordinates
Или используй такие функции

Код:

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

''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''
''  written by Bryco
'' original code from there:
''  http://forums.autodesk.com/t5/Visual-Basic-Customization/TranslateCoordinates/m-p/1537142/highlight/true
''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''
Function ToUcs(Pt As Variant) As Variant
ToUcs = ThisDrawing.Utility.TranslateCoordinates(Pt, acWorld, acUCS, False)
End Function
Function ToWcs(Pt As Variant) As Variant
ToWcs = ThisDrawing.Utility.TranslateCoordinates(Pt, acUCS, acWorld, False)
End Function

~'J'~

[meugen]

Сообщение от Кулик Алексей aka kpblc WKS, BKS - это что такое?

нашел! WKS > WCS
BKS > UCS

[meugen]

Вчера разбил себе лоб об стенку, всёравно не понял как работает выбор обьектов, могу ли я задать подробно вопросы или ето слишком напряжно?

всё, вопрос отпал. Всё заработало как часики. Всем спасибо!!!