[vasyavip]

Здравствуйте, Господа!
Подскажите пожалуйста:
Как с помощью vba начертить группу линий, их образмерить и вставить на чертеже там, где это нужно пользователю!

Я хочу создать базу небольших примитивов, таких как:
линия разрыва, уровень, штамп, спецификация(с выбором количества строк), ведомость расхода стали и все это вставить туда куда надо пользователю а не привязывать к нулевой точке.
Спасибо за ответы.

З.Ы.
завтра скину сюда код спецификации (общестроительной), надеюсь на вашу критику.

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

Ну, например, так:

Код:

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

Dim pt1(2) As Double, pt2(2) As Double
pt1(0)=0#: pt1(1)=0#: pt1(2)=0#
pt2(0)=100#: pt2(1)=-200.456: pt2(2)=0#
ThisDrawing.ModelSpace.AddLine pt1, pt2

Пишу без запущенной vbaide, так что могу ошибаться.

[vasyavip]

а как вставить туда куда мне надо?
как прикрепить эту линию к курсору и ждать ввода точки для вставки, определенную пользователем, т.е. мной!

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

Как идея: создавать анонимный блок, в него засобачивать все примитивы, следом выполнять _.-insert и ждать завершения команды с проверкой введенной точки. Головняк...

[vasyavip]

вот мой первый опыт
Хочу написать к ней спецификацию!
Как ее вставить не в модель а в лист?
И опять таки туда куда мне надо!
Без привязки к нулю!

[stas_org]

http://www.cadhlp.kulichki.ru/old/vba/codes.htm

[vasyavip]

Вот код спецификации

Как довести ее до совершенства?!
А то поинты можно вводить до сотен миллионов. Должен быть более простой способ написания кода тиражирования линий

Код:

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

Private Sub UserForm_Initialize()
'добавим информацию в ComboBox1
    ComboBox1.AddItem "10"
    ComboBox1.AddItem "20"
    ComboBox1.AddItem "30"
    ComboBox1.AddItem "40"
    ComboBox1.AddItem "50"
End Sub
Private Sub CommandButton1_Click() 'таблица
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double ' первая горизонтальная линия
    Dim endPoint(0 To 2) As Double
    startPoint(0) = 0#: startPoint(1) = 0#: startPoint(2) = 0#
    endPoint(0) = 185#: endPoint(1) = 0#: endPoint(2) = 0#
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    
    Dim lineObj1 As AcadLine
    Dim startPoint1(0 To 2) As Double ' вторая горизонтальная линия
    Dim endPoint1(0 To 2) As Double
    startPoint1(0) = 0#: startPoint1(1) = -16#: startPoint1(2) = 0#
    endPoint1(0) = 185#: endPoint1(1) = -16#: endPoint1(2) = 0#
    Set lineObj1 = ThisDrawing.ModelSpace.AddLine(startPoint1, endPoint1)
    
'*********************************************************************************************
    Dim lineObj2 As AcadLine
    Dim startPoint2(0 To 2) As Double ' первая вертикальная линия
    Dim endPoint2(0 To 2) As Double
    startPoint2(0) = 0#: startPoint2(1) = 0#: startPoint2(2) = 0#
    endPoint2(0) = 0#: endPoint2(1) = -32#: endPoint2(2) = 0#
    Set lineObj2 = ThisDrawing.ModelSpace.AddLine(startPoint2, endPoint2)
    
    Dim lineObj3 As AcadLine
    Dim startPoint3(0 To 2) As Double ' вторая вертикальная линия
    Dim endPoint3(0 To 2) As Double
    startPoint3(0) = 20#: startPoint3(1) = 0#: startPoint3(2) = 0#
    endPoint3(0) = 20#: endPoint3(1) = -32#: endPoint3(2) = 0#
    Set lineObj3 = ThisDrawing.ModelSpace.AddLine(startPoint3, endPoint3)
    
    Dim lineObj4 As AcadLine
    Dim startPoint4(0 To 2) As Double ' третья вертикальная линия
    Dim endPoint4(0 To 2) As Double
    startPoint4(0) = 80#: startPoint4(1) = 0#: startPoint4(2) = 0#
    endPoint4(0) = 80#: endPoint4(1) = -32#: endPoint4(2) = 0#
    Set lineObj4 = ThisDrawing.ModelSpace.AddLine(startPoint4, endPoint4)
    
    Dim lineObj5 As AcadLine
    Dim startPoint5(0 To 2) As Double ' четвертая вертикальная линия
    Dim endPoint5(0 To 2) As Double
    startPoint5(0) = 140#: startPoint5(1) = 0#: startPoint5(2) = 0#
    endPoint5(0) = 140#: endPoint5(1) = -32#: endPoint5(2) = 0#
    Set lineObj5 = ThisDrawing.ModelSpace.AddLine(startPoint5, endPoint5)
    
    Dim lineObj6 As AcadLine
    Dim startPoint6(0 To 2) As Double ' пятая вертикальная линия
    Dim endPoint6(0 To 2) As Double
    startPoint6(0) = 150#: startPoint6(1) = 0#: startPoint6(2) = 0#
    endPoint6(0) = 150#: endPoint6(1) = -32#: endPoint6(2) = 0#
    Set lineObj6 = ThisDrawing.ModelSpace.AddLine(startPoint6, endPoint6)
    
    Dim lineObj7 As AcadLine
    Dim startPoint7(0 To 2) As Double ' шестая вертикальная линия
    Dim endPoint7(0 To 2) As Double
    startPoint7(0) = 165#: startPoint7(1) = 0#: startPoint7(2) = 0#
    endPoint7(0) = 165#: endPoint7(1) = -32#: endPoint7(2) = 0#
    Set lineObj7 = ThisDrawing.ModelSpace.AddLine(startPoint7, endPoint7)
    
    Dim lineObj8 As AcadLine
    Dim startPoint8(0 To 2) As Double ' седьмая вертикальная линия
    Dim endPoint8(0 To 2) As Double
    startPoint8(0) = 185#: startPoint8(1) = 0#: startPoint8(2) = 0#
    endPoint8(0) = 185#: endPoint8(1) = -32#: endPoint8(2) = 0#
    Set lineObj8 = ThisDrawing.ModelSpace.AddLine(startPoint8, endPoint8)
    
'*************************************************************************************************
    If ComboBox1.Text = 10 Then
    Dim lineObj9 As AcadLine
    Dim startPoint9(0 To 2) As Double ' первая строка таблицы
    Dim endPoint9(0 To 2) As Double
    startPoint9(0) = 0#: startPoint9(1) = -24#: startPoint9(2) = 0#
    endPoint9(0) = 185#: endPoint9(1) = -24#: endPoint9(2) = 0#
    Set lineObj9 = ThisDrawing.ModelSpace.AddLine(startPoint9, endPoint9)

    Dim lineObj10 As AcadLine
    Dim startPoint10(0 To 2) As Double ' вторая строка таблицы
    Dim endPoint10(0 To 2) As Double
    startPoint10(0) = 0#: startPoint10(1) = -32#: startPoint10(2) = 0#
    endPoint10(0) = 185#: endPoint10(1) = -32#: endPoint10(2) = 0#
    Set lineObj10 = ThisDrawing.ModelSpace.AddLine(startPoint10, endPoint10)

    Dim lineObj11 As AcadLine
    Dim startPoint11(0 To 2) As Double ' третья строка таблицы
    Dim endPoint11(0 To 2) As Double
    startPoint11(0) = 0#: startPoint11(1) = -40#: startPoint11(2) = 0#
    endPoint11(0) = 185#: endPoint11(1) = -40#: endPoint11(2) = 0#
    Set lineObj11 = ThisDrawing.ModelSpace.AddLine(startPoint11, endPoint11)
    
    Dim lineObj19 As AcadLine
    Dim startPoint19(0 To 2) As Double ' четвертая строка таблицы
    Dim endPoint19(0 To 2) As Double
    startPoint19(0) = 0#: startPoint19(1) = -48#: startPoint19(2) = 0#
    endPoint19(0) = 185#: endPoint19(1) = -48#: endPoint19(2) = 0#
    Set lineObj19 = ThisDrawing.ModelSpace.AddLine(startPoint19, endPoint19)
    
    Dim lineObj20 As AcadLine
    Dim startPoint20(0 To 2) As Double ' пятая строка таблицы
    Dim endPoint20(0 To 2) As Double
    startPoint20(0) = 0#: startPoint20(1) = -56#: startPoint20(2) = 0#
    endPoint20(0) = 185#: endPoint20(1) = -56#: endPoint20(2) = 0#
    Set lineObj20 = ThisDrawing.ModelSpace.AddLine(startPoint20, endPoint20)
    
    Dim lineObj21 As AcadLine
    Dim startPoint21(0 To 2) As Double ' шестая строка таблицы
    Dim endPoint21(0 To 2) As Double
    startPoint21(0) = 0#: startPoint21(1) = -64#: startPoint21(2) = 0#
    endPoint21(0) = 185#: endPoint21(1) = -64#: endPoint21(2) = 0#
    Set lineObj21 = ThisDrawing.ModelSpace.AddLine(startPoint21, endPoint21)
    
    Dim lineObj22 As AcadLine
    Dim startPoint22(0 To 2) As Double ' седьмая строка таблицы
    Dim endPoint22(0 To 2) As Double
    startPoint22(0) = 0#: startPoint22(1) = -72#: startPoint22(2) = 0#
    endPoint22(0) = 185#: endPoint22(1) = -72#: endPoint22(2) = 0#
    Set lineObj22 = ThisDrawing.ModelSpace.AddLine(startPoint22, endPoint22)
    
    Dim lineObj23 As AcadLine
    Dim startPoint23(0 To 2) As Double ' восьмая строка таблицы
    Dim endPoint23(0 To 2) As Double
    startPoint23(0) = 0#: startPoint23(1) = -80#: startPoint23(2) = 0#
    endPoint23(0) = 185#: endPoint23(1) = -80#: endPoint23(2) = 0#
    Set lineObj23 = ThisDrawing.ModelSpace.AddLine(startPoint23, endPoint23)
    
    Dim lineObj24 As AcadLine
    Dim startPoint24(0 To 2) As Double ' девятая строка таблицы
    Dim endPoint24(0 To 2) As Double
    startPoint24(0) = 0#: startPoint24(1) = -88#: startPoint24(2) = 0#
    endPoint24(0) = 185#: endPoint24(1) = -88#: endPoint24(2) = 0#
    Set lineObj24 = ThisDrawing.ModelSpace.AddLine(startPoint24, endPoint24)
    
    Dim lineObj25 As AcadLine
    Dim startPoint25(0 To 2) As Double ' десятая строка таблицы
    Dim endPoint25(0 To 2) As Double
    startPoint25(0) = 0#: startPoint25(1) = -96#: startPoint25(2) = 0#
    endPoint25(0) = 185#: endPoint25(1) = -96#: endPoint25(2) = 0#
    Set lineObj25 = ThisDrawing.ModelSpace.AddLine(startPoint25, endPoint25)
    
    Dim lineObj26 As AcadLine
    Dim startPoint26(0 To 2) As Double ' первая вертикальная линия
    Dim endPoint26(0 To 2) As Double
    startPoint26(0) = 0#: startPoint26(1) = -32#: startPoint26(2) = 0#
    endPoint26(0) = 0#: endPoint26(1) = -96#: endPoint26(2) = 0#
    Set lineObj26 = ThisDrawing.ModelSpace.AddLine(startPoint26, endPoint26)
    
    Dim lineObj27 As AcadLine
    Dim startPoint27(0 To 2) As Double ' вторая вертикальная линия
    Dim endPoint27(0 To 2) As Double
    startPoint27(0) = 20#: startPoint27(1) = -32#: startPoint27(2) = 0#
    endPoint27(0) = 20#: endPoint27(1) = -96#: endPoint27(2) = 0#
    Set lineObj27 = ThisDrawing.ModelSpace.AddLine(startPoint27, endPoint27)
    
    Dim lineObj28 As AcadLine
    Dim startPoint28(0 To 2) As Double ' третья вертикальная линия
    Dim endPoint28(0 To 2) As Double
    startPoint28(0) = 80#: startPoint28(1) = -32#: startPoint28(2) = 0#
    endPoint28(0) = 80#: endPoint28(1) = -96#: endPoint28(2) = 0#
    Set lineObj28 = ThisDrawing.ModelSpace.AddLine(startPoint28, endPoint28)
    
    Dim lineObj29 As AcadLine
    Dim startPoint29(0 To 2) As Double ' четвертая вертикальная линия
    Dim endPoint29(0 To 2) As Double
    startPoint29(0) = 140#: startPoint29(1) = -32#: startPoint29(2) = 0#
    endPoint29(0) = 140#: endPoint29(1) = -96#: endPoint29(2) = 0#
    Set lineObj29 = ThisDrawing.ModelSpace.AddLine(startPoint29, endPoint29)
    
    Dim lineObj30 As AcadLine
    Dim startPoint30(0 To 2) As Double ' пятая вертикальная линия
    Dim endPoint30(0 To 2) As Double
    startPoint30(0) = 150#: startPoint30(1) = -32#: startPoint30(2) = 0#
    endPoint30(0) = 150#: endPoint30(1) = -96#: endPoint30(2) = 0#
    Set lineObj30 = ThisDrawing.ModelSpace.AddLine(startPoint30, endPoint30)
    
    Dim lineObj31 As AcadLine
    Dim startPoint31(0 To 2) As Double ' шестая вертикальная линия
    Dim endPoint31(0 To 2) As Double
    startPoint31(0) = 165#: startPoint31(1) = -32#: startPoint31(2) = 0#
    endPoint31(0) = 165#: endPoint31(1) = -96#: endPoint31(2) = 0#
    Set lineObj31 = ThisDrawing.ModelSpace.AddLine(startPoint31, endPoint31)
    
    Dim lineObj32 As AcadLine
    Dim startPoint32(0 To 2) As Double ' седьмая вертикальная линия
    Dim endPoint32(0 To 2) As Double
    startPoint32(0) = 185#: startPoint32(1) = -32#: startPoint32(2) = 0#
    endPoint32(0) = 185#: endPoint32(1) = -96#: endPoint32(2) = 0#
    Set lineObj32 = ThisDrawing.ModelSpace.AddLine(startPoint32, endPoint32)
    End If
'************************************************************************************************
    If ComboBox1.Text = 20 Then
    Dim lineObj33 As AcadLine
    Dim startPoint33(0 To 2) As Double ' первая строка таблицы
    Dim endPoint33(0 To 2) As Double
    startPoint33(0) = 0#: startPoint33(1) = -24#: startPoint33(2) = 0#
    endPoint33(0) = 185#: endPoint33(1) = -24#: endPoint33(2) = 0#
    Set lineObj33 = ThisDrawing.ModelSpace.AddLine(startPoint33, endPoint33)

    Dim lineObj34 As AcadLine
    Dim startPoint34(0 To 2) As Double ' вторая строка таблицы
    Dim endPoint34(0 To 2) As Double
    startPoint34(0) = 0#: startPoint34(1) = -32#: startPoint34(2) = 0#
    endPoint34(0) = 185#: endPoint34(1) = -32#: endPoint34(2) = 0#
    Set lineObj34 = ThisDrawing.ModelSpace.AddLine(startPoint34, endPoint34)

    Dim lineObj35 As AcadLine
    Dim startPoint35(0 To 2) As Double ' третья строка таблицы
    Dim endPoint35(0 To 2) As Double
    startPoint35(0) = 0#: startPoint35(1) = -40#: startPoint35(2) = 0#
    endPoint35(0) = 185#: endPoint35(1) = -40#: endPoint35(2) = 0#
    Set lineObj35 = ThisDrawing.ModelSpace.AddLine(startPoint35, endPoint35)
    
    Dim lineObj36 As AcadLine
    Dim startPoint36(0 To 2) As Double ' четвертая строка таблицы
    Dim endPoint36(0 To 2) As Double
    startPoint36(0) = 0#: startPoint36(1) = -48#: startPoint36(2) = 0#
    endPoint36(0) = 185#: endPoint36(1) = -48#: endPoint36(2) = 0#
    Set lineObj36 = ThisDrawing.ModelSpace.AddLine(startPoint36, endPoint36)
    
    Dim lineObj37 As AcadLine
    Dim startPoint37(0 To 2) As Double ' пятая строка таблицы
    Dim endPoint37(0 To 2) As Double
    startPoint37(0) = 0#: startPoint37(1) = -56#: startPoint37(2) = 0#
    endPoint37(0) = 185#: endPoint37(1) = -56#: endPoint37(2) = 0#
    Set lineObj37 = ThisDrawing.ModelSpace.AddLine(startPoint37, endPoint37)
    
    Dim lineObj38 As AcadLine
    Dim startPoint38(0 To 2) As Double ' шестая строка таблицы
    Dim endPoint38(0 To 2) As Double
    startPoint38(0) = 0#: startPoint38(1) = -64#: startPoint38(2) = 0#
    endPoint38(0) = 185#: endPoint38(1) = -64#: endPoint38(2) = 0#
    Set lineObj38 = ThisDrawing.ModelSpace.AddLine(startPoint38, endPoint38)
    
    Dim lineObj39 As AcadLine
    Dim startPoint39(0 To 2) As Double ' седьмая строка таблицы
    Dim endPoint39(0 To 2) As Double
    startPoint39(0) = 0#: startPoint39(1) = -72#: startPoint39(2) = 0#
    endPoint39(0) = 185#: endPoint39(1) = -72#: endPoint39(2) = 0#
    Set lineObj39 = ThisDrawing.ModelSpace.AddLine(startPoint39, endPoint39)
    
    Dim lineObj40 As AcadLine
    Dim startPoint40(0 To 2) As Double ' восьмая строка таблицы
    Dim endPoint40(0 To 2) As Double
    startPoint40(0) = 0#: startPoint40(1) = -80#: startPoint40(2) = 0#
    endPoint40(0) = 185#: endPoint40(1) = -80#: endPoint40(2) = 0#
    Set lineObj40 = ThisDrawing.ModelSpace.AddLine(startPoint40, endPoint40)
    
    Dim lineObj41 As AcadLine
    Dim startPoint41(0 To 2) As Double ' девятая строка таблицы
    Dim endPoint41(0 To 2) As Double
    startPoint41(0) = 0#: startPoint41(1) = -88#: startPoint41(2) = 0#
    endPoint41(0) = 185#: endPoint41(1) = -88#: endPoint41(2) = 0#
    Set lineObj41 = ThisDrawing.ModelSpace.AddLine(startPoint41, endPoint41)
    
    Dim lineObj42 As AcadLine
    Dim startPoint42(0 To 2) As Double ' десятая строка таблицы
    Dim endPoint42(0 To 2) As Double
    startPoint42(0) = 0#: startPoint42(1) = -96#: startPoint42(2) = 0#
    endPoint42(0) = 185#: endPoint42(1) = -96#: endPoint42(2) = 0#
    Set lineObj42 = ThisDrawing.ModelSpace.AddLine(startPoint42, endPoint42)
    
    Dim lineObj43 As AcadLine
    Dim startPoint43(0 To 2) As Double ' одиннадцатая строка таблицы
    Dim endPoint43(0 To 2) As Double
    startPoint43(0) = 0#: startPoint43(1) = -104#: startPoint43(2) = 0#
    endPoint43(0) = 185#: endPoint43(1) = -104#: endPoint43(2) = 0#
    Set lineObj43 = ThisDrawing.ModelSpace.AddLine(startPoint43, endPoint43)

    Dim lineObj44 As AcadLine
    Dim startPoint44(0 To 2) As Double ' двенадцатая строка таблицы
    Dim endPoint44(0 To 2) As Double
    startPoint44(0) = 0#: startPoint44(1) = -112#: startPoint44(2) = 0#
    endPoint44(0) = 185#: endPoint44(1) = -112#: endPoint44(2) = 0#
    Set lineObj44 = ThisDrawing.ModelSpace.AddLine(startPoint44, endPoint44)

    Dim lineObj45 As AcadLine
    Dim startPoint45(0 To 2) As Double ' тринадцатая строка таблицы
    Dim endPoint45(0 To 2) As Double
    startPoint45(0) = 0#: startPoint45(1) = -120#: startPoint45(2) = 0#
    endPoint45(0) = 185#: endPoint45(1) = -120#: endPoint45(2) = 0#
    Set lineObj45 = ThisDrawing.ModelSpace.AddLine(startPoint45, endPoint45)
    
    Dim lineObj46 As AcadLine
    Dim startPoint46(0 To 2) As Double ' четырнадцатая строка таблицы
    Dim endPoint46(0 To 2) As Double
    startPoint46(0) = 0#: startPoint46(1) = -128#: startPoint46(2) = 0#
    endPoint46(0) = 185#: endPoint46(1) = -128#: endPoint46(2) = 0#
    Set lineObj46 = ThisDrawing.ModelSpace.AddLine(startPoint46, endPoint46)
    
    Dim lineObj47 As AcadLine
    Dim startPoint47(0 To 2) As Double ' пятьнадцатая строка таблицы
    Dim endPoint47(0 To 2) As Double
    startPoint47(0) = 0#: startPoint47(1) = -136#: startPoint47(2) = 0#
    endPoint47(0) = 185#: endPoint47(1) = -136#: endPoint47(2) = 0#
    Set lineObj47 = ThisDrawing.ModelSpace.AddLine(startPoint47, endPoint47)
    
    Dim lineObj48 As AcadLine
    Dim startPoint48(0 To 2) As Double ' шестьнадцатая строка таблицы
    Dim endPoint48(0 To 2) As Double
    startPoint48(0) = 0#: startPoint48(1) = -144#: startPoint48(2) = 0#
    endPoint48(0) = 185#: endPoint48(1) = -144#: endPoint48(2) = 0#
    Set lineObj48 = ThisDrawing.ModelSpace.AddLine(startPoint48, endPoint48)
    
    Dim lineObj49 As AcadLine
    Dim startPoint49(0 To 2) As Double ' семьнадцатая строка таблицы
    Dim endPoint49(0 To 2) As Double
    startPoint49(0) = 0#: startPoint49(1) = -152#: startPoint49(2) = 0#
    endPoint49(0) = 185#: endPoint49(1) = -152#: endPoint49(2) = 0#
    Set lineObj49 = ThisDrawing.ModelSpace.AddLine(startPoint49, endPoint49)
    
    Dim lineObj50 As AcadLine
    Dim startPoint50(0 To 2) As Double ' восемьнадцатая строка таблицы
    Dim endPoint50(0 To 2) As Double
    startPoint50(0) = 0#: startPoint50(1) = -160#: startPoint50(2) = 0#
    endPoint50(0) = 185#: endPoint50(1) = -160#: endPoint50(2) = 0#
    Set lineObj50 = ThisDrawing.ModelSpace.AddLine(startPoint50, endPoint50)
    
    Dim lineObj51 As AcadLine
    Dim startPoint51(0 To 2) As Double ' девятьнадцатая строка таблицы
    Dim endPoint51(0 To 2) As Double
    startPoint51(0) = 0#: startPoint51(1) = -168#: startPoint51(2) = 0#
    endPoint51(0) = 185#: endPoint51(1) = -168#: endPoint51(2) = 0#
    Set lineObj51 = ThisDrawing.ModelSpace.AddLine(startPoint51, endPoint51)
    
    Dim lineObj52 As AcadLine
    Dim startPoint52(0 To 2) As Double ' двадцатая строка таблицы
    Dim endPoint52(0 To 2) As Double
    startPoint52(0) = 0#: startPoint52(1) = -176#: startPoint52(2) = 0#
    endPoint52(0) = 185#: endPoint52(1) = -176#: endPoint52(2) = 0#
    Set lineObj52 = ThisDrawing.ModelSpace.AddLine(startPoint52, endPoint52)
    
    Dim lineObj53 As AcadLine
    Dim startPoint53(0 To 2) As Double ' первая вертикальная линия
    Dim endPoint53(0 To 2) As Double
    startPoint53(0) = 0#: startPoint53(1) = -32#: startPoint53(2) = 0#
    endPoint53(0) = 0#: endPoint53(1) = -176#: endPoint53(2) = 0#
    Set lineObj53 = ThisDrawing.ModelSpace.AddLine(startPoint53, endPoint53)
    
    Dim lineObj54 As AcadLine
    Dim startPoint54(0 To 2) As Double ' вторая вертикальная линия
    Dim endPoint54(0 To 2) As Double
    startPoint54(0) = 20#: startPoint54(1) = -32#: startPoint54(2) = 0#
    endPoint54(0) = 20#: endPoint54(1) = -176#: endPoint54(2) = 0#
    Set lineObj54 = ThisDrawing.ModelSpace.AddLine(startPoint54, endPoint54)
    
    Dim lineObj55 As AcadLine
    Dim startPoint55(0 To 2) As Double ' третья вертикальная линия
    Dim endPoint55(0 To 2) As Double
    startPoint55(0) = 80#: startPoint55(1) = -32#: startPoint55(2) = 0#
    endPoint55(0) = 80#: endPoint55(1) = -176#: endPoint55(2) = 0#
    Set lineObj55 = ThisDrawing.ModelSpace.AddLine(startPoint55, endPoint55)
    
    Dim lineObj56 As AcadLine
    Dim startPoint56(0 To 2) As Double ' четвертая вертикальная линия
    Dim endPoint56(0 To 2) As Double
    startPoint56(0) = 140#: startPoint56(1) = -32#: startPoint56(2) = 0#
    endPoint56(0) = 140#: endPoint56(1) = -176#: endPoint56(2) = 0#
    Set lineObj56 = ThisDrawing.ModelSpace.AddLine(startPoint56, endPoint56)
    
    Dim lineObj57 As AcadLine
    Dim startPoint57(0 To 2) As Double ' пятая вертикальная линия
    Dim endPoint57(0 To 2) As Double
    startPoint57(0) = 150#: startPoint57(1) = -32#: startPoint57(2) = 0#
    endPoint57(0) = 150#: endPoint57(1) = -176#: endPoint57(2) = 0#
    Set lineObj57 = ThisDrawing.ModelSpace.AddLine(startPoint57, endPoint57)
    
    Dim lineObj58 As AcadLine
    Dim startPoint58(0 To 2) As Double ' шестая вертикальная линия
    Dim endPoint58(0 To 2) As Double
    startPoint58(0) = 165#: startPoint58(1) = -32#: startPoint58(2) = 0#
    endPoint58(0) = 165#: endPoint58(1) = -176#: endPoint58(2) = 0#
    Set lineObj58 = ThisDrawing.ModelSpace.AddLine(startPoint58, endPoint58)
    
    Dim lineObj59 As AcadLine
    Dim startPoint59(0 To 2) As Double ' седьмая вертикальная линия
    Dim endPoint59(0 To 2) As Double
    startPoint59(0) = 185#: startPoint59(1) = -32#: startPoint59(2) = 0#
    endPoint59(0) = 185#: endPoint59(1) = -176#: endPoint59(2) = 0#
    Set lineObj59 = ThisDrawing.ModelSpace.AddLine(startPoint59, endPoint59)
    End If
'***********************************************************************************************
    If ComboBox1.Text = 30 Then
    Dim lineObj60 As AcadLine
    Dim startPoint60(0 To 2) As Double ' первая строка таблицы
    Dim endPoint60(0 To 2) As Double
    startPoint60(0) = 0#: startPoint60(1) = -24#: startPoint60(2) = 0#
    endPoint60(0) = 185#: endPoint60(1) = -24#: endPoint60(2) = 0#
    Set lineObj60 = ThisDrawing.ModelSpace.AddLine(startPoint60, endPoint60)

    Dim lineObj61 As AcadLine
    Dim startPoint61(0 To 2) As Double ' вторая строка таблицы
    Dim endPoint61(0 To 2) As Double
    startPoint61(0) = 0#: startPoint61(1) = -32#: startPoint61(2) = 0#
    endPoint61(0) = 185#: endPoint61(1) = -32#: endPoint61(2) = 0#
    Set lineObj61 = ThisDrawing.ModelSpace.AddLine(startPoint61, endPoint61)

    Dim lineObj62 As AcadLine
    Dim startPoint62(0 To 2) As Double ' третья строка таблицы
    Dim endPoint62(0 To 2) As Double
    startPoint62(0) = 0#: startPoint62(1) = -40#: startPoint62(2) = 0#
    endPoint62(0) = 185#: endPoint62(1) = -40#: endPoint62(2) = 0#
    Set lineObj62 = ThisDrawing.ModelSpace.AddLine(startPoint62, endPoint62)
    
    Dim lineObj63 As AcadLine
    Dim startPoint63(0 To 2) As Double ' четвертая строка таблицы
    Dim endPoint63(0 To 2) As Double
    startPoint63(0) = 0#: startPoint63(1) = -48#: startPoint63(2) = 0#
    endPoint63(0) = 185#: endPoint63(1) = -48#: endPoint63(2) = 0#
    Set lineObj63 = ThisDrawing.ModelSpace.AddLine(startPoint63, endPoint63)
    
    Dim lineObj64 As AcadLine
    Dim startPoint64(0 To 2) As Double ' пятая строка таблицы
    Dim endPoint64(0 To 2) As Double
    startPoint64(0) = 0#: startPoint64(1) = -56#: startPoint64(2) = 0#
    endPoint64(0) = 185#: endPoint64(1) = -56#: endPoint64(2) = 0#
    Set lineObj64 = ThisDrawing.ModelSpace.AddLine(startPoint64, endPoint64)
    
    Dim lineObj65 As AcadLine
    Dim startPoint65(0 To 2) As Double ' шестая строка таблицы
    Dim endPoint65(0 To 2) As Double
    startPoint65(0) = 0#: startPoint65(1) = -64#: startPoint65(2) = 0#
    endPoint65(0) = 185#: endPoint65(1) = -64#: endPoint65(2) = 0#
    Set lineObj65 = ThisDrawing.ModelSpace.AddLine(startPoint65, endPoint65)
    
    Dim lineObj66 As AcadLine
    Dim startPoint66(0 To 2) As Double ' седьмая строка таблицы
    Dim endPoint66(0 To 2) As Double
    startPoint66(0) = 0#: startPoint66(1) = -72#: startPoint66(2) = 0#
    endPoint66(0) = 185#: endPoint66(1) = -72#: endPoint66(2) = 0#
    Set lineObj66 = ThisDrawing.ModelSpace.AddLine(startPoint66, endPoint66)
    
    Dim lineObj67 As AcadLine
    Dim startPoint67(0 To 2) As Double ' восьмая строка таблицы
    Dim endPoint67(0 To 2) As Double
    startPoint67(0) = 0#: startPoint67(1) = -80#: startPoint67(2) = 0#
    endPoint67(0) = 185#: endPoint67(1) = -80#: endPoint67(2) = 0#
    Set lineObj67 = ThisDrawing.ModelSpace.AddLine(startPoint67, endPoint67)
    
    Dim lineOb68 As AcadLine
    Dim startPoint68(0 To 2) As Double ' девятая строка таблицы
    Dim endPoint68(0 To 2) As Double
    startPoint68(0) = 0#: startPoint68(1) = -88#: startPoint68(2) = 0#
    endPoint68(0) = 185#: endPoint68(1) = -88#: endPoint68(2) = 0#
    Set lineObj68 = ThisDrawing.ModelSpace.AddLine(startPoint68, endPoint68)
    
    Dim lineObj69 As AcadLine
    Dim startPoint69(0 To 2) As Double ' десятая строка таблицы
    Dim endPoint69(0 To 2) As Double
    startPoint69(0) = 0#: startPoint69(1) = -96#: startPoint69(2) = 0#
    endPoint69(0) = 185#: endPoint69(1) = -96#: endPoint69(2) = 0#
    Set lineObj69 = ThisDrawing.ModelSpace.AddLine(startPoint69, endPoint69)
    
    Dim lineObj70 As AcadLine
    Dim startPoint70(0 To 2) As Double ' одиннадцатая строка таблицы
    Dim endPoint70(0 To 2) As Double
    startPoint70(0) = 0#: startPoint70(1) = -104#: startPoint70(2) = 0#
    endPoint70(0) = 185#: endPoint70(1) = -104#: endPoint70(2) = 0#
    Set lineObj70 = ThisDrawing.ModelSpace.AddLine(startPoint70, endPoint70)

    Dim lineObj71 As AcadLine
    Dim startPoint71(0 To 2) As Double ' двенадцатая строка таблицы
    Dim endPoint71(0 To 2) As Double
    startPoint71(0) = 0#: startPoint71(1) = -112#: startPoint71(2) = 0#
    endPoint71(0) = 185#: endPoint71(1) = -112#: endPoint71(2) = 0#
    Set lineObj71 = ThisDrawing.ModelSpace.AddLine(startPoint71, endPoint71)

    Dim lineObj72 As AcadLine
    Dim startPoint72(0 To 2) As Double ' тринадцатая строка таблицы
    Dim endPoint72(0 To 2) As Double
    startPoint72(0) = 0#: startPoint72(1) = -120#: startPoint72(2) = 0#
    endPoint72(0) = 185#: endPoint72(1) = -120#: endPoint72(2) = 0#
    Set lineObj72 = ThisDrawing.ModelSpace.AddLine(startPoint72, endPoint72)
    
    Dim lineObj73 As AcadLine
    Dim startPoint73(0 To 2) As Double ' четырнадцатая строка таблицы
    Dim endPoint73(0 To 2) As Double
    startPoint73(0) = 0#: startPoint73(1) = -128#: startPoint73(2) = 0#
    endPoint73(0) = 185#: endPoint73(1) = -128#: endPoint73(2) = 0#
    Set lineObj73 = ThisDrawing.ModelSpace.AddLine(startPoint73, endPoint73)
    
    Dim lineObj74 As AcadLine
    Dim startPoint74(0 To 2) As Double ' пятьнадцатая строка таблицы
    Dim endPoint74(0 To 2) As Double
    startPoint74(0) = 0#: startPoint74(1) = -136#: startPoint74(2) = 0#
    endPoint74(0) = 185#: endPoint74(1) = -136#: endPoint74(2) = 0#
    Set lineObj74 = ThisDrawing.ModelSpace.AddLine(startPoint74, endPoint74)
    
    Dim lineObj75 As AcadLine
    Dim startPoint75(0 To 2) As Double ' шестьнадцатая строка таблицы
    Dim endPoint75(0 To 2) As Double
    startPoint75(0) = 0#: startPoint75(1) = -144#: startPoint75(2) = 0#
    endPoint75(0) = 185#: endPoint75(1) = -144#: endPoint75(2) = 0#
    Set lineObj75 = ThisDrawing.ModelSpace.AddLine(startPoint75, endPoint75)
    
    Dim lineObj76 As AcadLine
    Dim startPoint76(0 To 2) As Double ' семьнадцатая строка таблицы
    Dim endPoint76(0 To 2) As Double
    startPoint76(0) = 0#: startPoint76(1) = -152#: startPoint76(2) = 0#
    endPoint76(0) = 185#: endPoint76(1) = -152#: endPoint76(2) = 0#
    Set lineObj76 = ThisDrawing.ModelSpace.AddLine(startPoint76, endPoint76)
    
    Dim lineObj77 As AcadLine
    Dim startPoint77(0 To 2) As Double ' восемьнадцатая строка таблицы
    Dim endPoint77(0 To 2) As Double
    startPoint77(0) = 0#: startPoint77(1) = -160#: startPoint77(2) = 0#
    endPoint77(0) = 185#: endPoint77(1) = -160#: endPoint77(2) = 0#
    Set lineObj77 = ThisDrawing.ModelSpace.AddLine(startPoint77, endPoint77)
    
    Dim lineObj78 As AcadLine
    Dim startPoint78(0 To 2) As Double ' девятьнадцатая строка таблицы
    Dim endPoint78(0 To 2) As Double
    startPoint78(0) = 0#: startPoint78(1) = -168#: startPoint78(2) = 0#
    endPoint78(0) = 185#: endPoint78(1) = -168#: endPoint78(2) = 0#
    Set lineObj78 = ThisDrawing.ModelSpace.AddLine(startPoint78, endPoint78)
    
    Dim lineObj79 As AcadLine
    Dim startPoint79(0 To 2) As Double ' двадцатая строка таблицы
    Dim endPoint79(0 To 2) As Double
    startPoint79(0) = 0#: startPoint79(1) = -176#: startPoint79(2) = 0#
    endPoint79(0) = 185#: endPoint79(1) = -176#: endPoint79(2) = 0#
    Set lineObj79 = ThisDrawing.ModelSpace.AddLine(startPoint79, endPoint79)
    
    Dim lineObj80 As AcadLine
    Dim startPoint80(0 To 2) As Double ' двадцатьпервая строка таблицы
    Dim endPoint80(0 To 2) As Double
    startPoint80(0) = 0#: startPoint80(1) = -184#: startPoint80(2) = 0#
    endPoint80(0) = 185#: endPoint80(1) = -184#: endPoint80(2) = 0#
    Set lineObj80 = ThisDrawing.ModelSpace.AddLine(startPoint80, endPoint80)
    
    Dim lineObj81 As AcadLine
    Dim startPoint81(0 To 2) As Double ' двадцатьвторая строка таблицы
    Dim endPoint81(0 To 2) As Double
    startPoint81(0) = 0#: startPoint81(1) = -192#: startPoint81(2) = 0#
    endPoint81(0) = 185#: endPoint81(1) = -192#: endPoint81(2) = 0#
    Set lineObj81 = ThisDrawing.ModelSpace.AddLine(startPoint81, endPoint81)
    
    Dim lineObj82 As AcadLine
    Dim startPoint82(0 To 2) As Double ' двадцатьтретья строка таблицы
    Dim endPoint82(0 To 2) As Double
    startPoint82(0) = 0#: startPoint82(1) = -200#: startPoint82(2) = 0#
    endPoint82(0) = 185#: endPoint82(1) = -200#: endPoint82(2) = 0#
    Set lineObj82 = ThisDrawing.ModelSpace.AddLine(startPoint82, endPoint82)
    
    Dim lineObj83 As AcadLine
    Dim startPoint83(0 To 2) As Double ' двадцатьчетвертая строка таблицы
    Dim endPoint83(0 To 2) As Double
    startPoint83(0) = 0#: startPoint83(1) = -208#: startPoint83(2) = 0#
    endPoint83(0) = 185#: endPoint83(1) = -208#: endPoint83(2) = 0#
    Set lineObj83 = ThisDrawing.ModelSpace.AddLine(startPoint83, endPoint83)
    
    Dim lineObj84 As AcadLine
    Dim startPoint84(0 To 2) As Double ' двадцатьпятая строка таблицы
    Dim endPoint84(0 To 2) As Double
    startPoint84(0) = 0#: startPoint84(1) = -216#: startPoint84(2) = 0#
    endPoint84(0) = 185#: endPoint84(1) = -216#: endPoint84(2) = 0#
    Set lineObj84 = ThisDrawing.ModelSpace.AddLine(startPoint84, endPoint84)
    
    Dim lineObj85 As AcadLine
    Dim startPoint85(0 To 2) As Double ' двадцатьшестая строка таблицы
    Dim endPoint85(0 To 2) As Double
    startPoint85(0) = 0#: startPoint85(1) = -224#: startPoint85(2) = 0#
    endPoint85(0) = 185#: endPoint85(1) = -224#: endPoint85(2) = 0#
    Set lineObj85 = ThisDrawing.ModelSpace.AddLine(startPoint85, endPoint85)
    
    Dim lineObj86 As AcadLine
    Dim startPoint86(0 To 2) As Double ' двадцатьседьмая строка таблицы
    Dim endPoint86(0 To 2) As Double
    startPoint86(0) = 0#: startPoint86(1) = -232#: startPoint86(2) = 0#
    endPoint86(0) = 185#: endPoint86(1) = -232#: endPoint86(2) = 0#
    Set lineObj86 = ThisDrawing.ModelSpace.AddLine(startPoint86, endPoint86)
    
    Dim lineObj87 As AcadLine
    Dim startPoint87(0 To 2) As Double ' двадцатьвосьмая строка таблицы
    Dim endPoint87(0 To 2) As Double
    startPoint87(0) = 0#: startPoint87(1) = -240#: startPoint87(2) = 0#
    endPoint87(0) = 185#: endPoint87(1) = -240#: endPoint87(2) = 0#
    Set lineObj87 = ThisDrawing.ModelSpace.AddLine(startPoint87, endPoint87)
    
    Dim lineObj88 As AcadLine
    Dim startPoint88(0 To 2) As Double ' двадцатьдевятая строка таблицы
    Dim endPoint88(0 To 2) As Double
    startPoint88(0) = 0#: startPoint88(1) = -248#: startPoint88(2) = 0#
    endPoint88(0) = 185#: endPoint88(1) = -248#: endPoint88(2) = 0#
    Set lineObj88 = ThisDrawing.ModelSpace.AddLine(startPoint88, endPoint88)
    
    Dim lineObj89 As AcadLine
    Dim startPoint89(0 To 2) As Double ' тридцатая строка таблицы
    Dim endPoint89(0 To 2) As Double
    startPoint89(0) = 0#: startPoint89(1) = -256#: startPoint89(2) = 0#
    endPoint89(0) = 185#: endPoint89(1) = -256#: endPoint89(2) = 0#
    Set lineObj89 = ThisDrawing.ModelSpace.AddLine(startPoint89, endPoint89)
    
    Dim lineObj90 As AcadLine
    Dim startPoint90(0 To 2) As Double ' первая вертикальная линия
    Dim endPoint90(0 To 2) As Double
    startPoint90(0) = 0#: startPoint90(1) = -32#: startPoint90(2) = 0#
    endPoint90(0) = 0#: endPoint90(1) = -256#: endPoint90(2) = 0#
    Set lineObj90 = ThisDrawing.ModelSpace.AddLine(startPoint90, endPoint90)
    
    Dim lineObj91 As AcadLine
    Dim startPoint91(0 To 2) As Double ' вторая вертикальная линия
    Dim endPoint91(0 To 2) As Double
    startPoint91(0) = 20#: startPoint91(1) = -32#: startPoint91(2) = 0#
    endPoint91(0) = 20#: endPoint91(1) = -256#: endPoint91(2) = 0#
    Set lineObj91 = ThisDrawing.ModelSpace.AddLine(startPoint91, endPoint91)
    
    Dim lineObj92 As AcadLine
    Dim startPoint92(0 To 2) As Double ' третья вертикальная линия
    Dim endPoint92(0 To 2) As Double
    startPoint92(0) = 80#: startPoint92(1) = -32#: startPoint92(2) = 0#
    endPoint92(0) = 80#: endPoint92(1) = -256#: endPoint92(2) = 0#
    Set lineObj92 = ThisDrawing.ModelSpace.AddLine(startPoint92, endPoint92)
    
    Dim lineObj93 As AcadLine
    Dim startPoint93(0 To 2) As Double ' четвертая вертикальная линия
    Dim endPoint93(0 To 2) As Double
    startPoint93(0) = 140#: startPoint93(1) = -32#: startPoint93(2) = 0#
    endPoint93(0) = 140#: endPoint93(1) = -256#: endPoint93(2) = 0#
    Set lineObj93 = ThisDrawing.ModelSpace.AddLine(startPoint93, endPoint93)
    
    Dim lineObj94 As AcadLine
    Dim startPoint94(0 To 2) As Double ' пятая вертикальная линия
    Dim endPoint94(0 To 2) As Double
    startPoint94(0) = 150#: startPoint94(1) = -32#: startPoint94(2) = 0#
    endPoint94(0) = 150#: endPoint94(1) = -256#: endPoint94(2) = 0#
    Set lineObj94 = ThisDrawing.ModelSpace.AddLine(startPoint94, endPoint94)
    
    Dim lineObj95 As AcadLine
    Dim startPoint95(0 To 2) As Double ' шестая вертикальная линия
    Dim endPoint95(0 To 2) As Double
    startPoint95(0) = 165#: startPoint95(1) = -32#: startPoint95(2) = 0#
    endPoint95(0) = 165#: endPoint95(1) = -256#: endPoint95(2) = 0#
    Set lineObj95 = ThisDrawing.ModelSpace.AddLine(startPoint95, endPoint95)
    
    Dim lineObj96 As AcadLine
    Dim startPoint96(0 To 2) As Double ' седьмая вертикальная линия
    Dim endPoint96(0 To 2) As Double
    startPoint96(0) = 185#: startPoint96(1) = -32#: startPoint96(2) = 0#
    endPoint96(0) = 185#: endPoint96(1) = -256#: endPoint96(2) = 0#
    Set lineObj96 = ThisDrawing.ModelSpace.AddLine(startPoint96, endPoint96)
    End If
    
    UserForm1.Hide
End Sub

[Клякса]

А почему блоком не вставить, как Алексей предлагает?

pntDropBlk = ThisDrawing.Utility.GetPoint(, vbCrLf & "Куда блок кинуть?")
Set objBlkRef = ThisDrawing.ModelSpace.InsertBlock(pntDropBlk, blkName, 1#, 1#, 1#, 0)

Первая строчка - получение точки вставки курсором, вторая- вставка блока, blkName - переменная имени блока

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

Вообще-то для спецификаций не проще ли использовать объект таблицы и работать с ним?

[vasyavip]

а как заполнить таблицу програмно?
так, чтобы она была таких размеров , какие мне надо!
Текст она должна принимать из textbox'ов, которые я заполняю в интерфейсе моей программы, той, что выше я выложил!
Стандартная таблица автокада - это хорошо, как ее программно сделать спецификацией на арматуру. (размеры ячеек)?

Для "КЛЯКСА"
как из вашего кода сделать блок не очень понял! Как сделать блок програмно из нескольких линий?

Если мне надо начертить линию разрыва, ладно, пусть будет она блоком, но всеже как эту группу линий превратить в блок? Как вставить? как повернуть на нужный угол?
Как вставить элемент не в пространство модели, а в пространство листа?!

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

Сообщение от vasyavip а как заполнить таблицу програмно

Как обычно. Примеры см.в справке

так, чтобы она была таких размеров , какие мне надо!

Определяется или модифицируется (если уже есть) стиль таблицы, указываются ширины столбцов - вот, в общем-то, и все.

Текст она должна принимать из textbox'ов, которые я заполняю в интерфейсе моей программы, той, что выше я выложил!

Это уже не сильно важно.

Стандартная таблица автокада - это хорошо, как ее программно сделать спецификацией на арматуру. (размеры ячеек)?

См.чуть выше
Дальше, хотя и не ко мне обращение, отвечу:

как из вашего кода сделать блок не очень понял! Как сделать блок програмно из нескольких линий?

Добавляется описание нового блока и внутрь этого блока добавляются примитивы.

Если мне надо начертить линию разрыва, ладно, пусть будет она блоком, но всеже как эту группу линий превратить в блок? Как вставить? как повернуть на нужный угол?

А метод InsertBlock уже не рассматривается, например?

[stas_org]

Сообщение от vasyavip а как заполнить таблицу програмно? так, чтобы она была таких размеров , какие мне надо!

Таблицу акада имеющимися инструментами нормально настроить не всегда получиться, не говоря уже программно. Поэтому поинтами лучше. Да, определяй каждую точку начала и конца, ничего страшного, глаза боятся-руки делают, copy-paste разруливает на 80%.

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

stas_org, ну не выдумывай, а! Таблица заполняется вполне корректно!

[stas_org]

как-то пытался простою форму спецификации настроить, по ГОСТу не вышло, плюнул на это дело, и из тулбаров убрал все, что связанно с таблицами. Но спорить не хочется, извиняюсь за разногласия, но никому никогда советовать работать с таблицами не буду, вот.

[stas_org]

таблици можно использовать как вспомогательный инструмент, но на рабочку лучше их не сувать.

[Vildar]

Ну в 2008 усе нормуль с таблицами, меня устраиват.
А если представить себе составление таблицйы палочками... фу бяка ))

[stas_org]

поэтому надо один раз программно палочками

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

Не-а, один раз программно и таблицу.

Код:

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

Sub test()
Dim dicTableStyles As AcadDictionary, sTableStyleName As String, lCounter As Long
Dim stTableStyle As AcadTableStyle
  'On Error GoTo lErrorMain
  Set dicTableStyles = ThisDrawing.Dictionaries.Item("ACAD_TABLESTYLE")
  sTableStyleName = "kpblc_TableStyleFull"
  For lCounter = 0 To dicTableStyles.Count - 1
    If dicTableStyles.Item(lCounter).Name = sTableStyleName Then
      Set stTableStyle = dicTableStyles.Item(lCounter)
      Exit For
    End If
  Next
  If stTableStyle Is Nothing Then
    Set stTableStyle = dicTableStyles.AddObject(sTableStyleName, "AcDbTableStyle")
  End If
  ' Устанавливаем настройки стиля таблицы
  Dim sTextStyle As String, lGridType As Long
  sTextStyle = ThisDrawing.GetVariable("textstyle")
  lGridType = acHorzInside + acHorzBottom + acHorzTop + acVertInside + acVertRight + acVertLeft
  With stTableStyle
    .FlowDirection = acTableTopToBottom
    .HeaderSuppressed = False
    .TitleSuppressed = False
    .SetTextStyle acTitleRow, sTextStyle:  .SetTextHeight acTitleRow, 5 ':    .SetColor acTitleRow, 0
    '.SetGridColor lGridType, acTitleRow, 0:
    .SetGridLineWeight lGridType, acTitleRow, acLnWtByBlock
    .SetTextStyle acHeaderRow, sTextStyle: .SetTextHeight acHeaderRow, 3.5 ': .SetColor acHeaderRow, 0
    '.SetGridColor lGridType, acHeaderRow, 0:
    .SetGridLineWeight lGridType, acHeaderRow, acLnWtByBlock
    '.SetTextStyle acDataRow, sTextStyle:
    .SetTextHeight acDataRow, 3.5 ':   .SetColor acDataRow, 0
    '.SetGridColor lGridType, acDataRow, 0:
    .SetGridLineWeight lGridType, acDataRow, acLnWtByBlock
  End With
  ' Теперь создаем анонимный блок
  Dim blkDef As AcadBlock, BasePoint(2) As Double
  BasePoint(0) = 0#: BasePoint(1) = 0#: BasePoint(2) = 0#
  Set blkDef = ThisDrawing.Blocks.Add(BasePoint, "*U")
  ' Вставляем в него таблицу
  Dim objTable As AcadTable
  Set objTable = blkDef.AddTable(BasePoint, 3, 5, 5, 10)
  ' Заполняем таблицу - это делать просто некогда
  ' И вставляем блок
  Dim lScaleFactor As Long
  lScaleFactor = ThisDrawing.GetVariable("dimscale")
  Dim vInsPoint As Variant, blkRef As AcadBlockReference
  On Error GoTo lErrorGetPoint
  vInsPoint = ThisDrawing.Utility.GetPoint(, "Точка вставки таблицы : ")
  On Error Resume Next
  Set blkRef = ThisDrawing.ModelSpace.InsertBlock(vInsPoint, blkDef.Name, lScaleFactor, lScaleFactor, lScaleFactor, 0)
  blkRef.Explode
  blkRef.Erase
  Exit Sub
lErrorGetPoint:
  MsgBox "Ошибка указания точки", vbOKOnly + vbCritical + vbApplicationModal, "Ошибка"
  Exit Sub
lErrorMain:
  MsgBox "Эта версия файла не имеет возможности создавать таблицы!", vbOKOnly + vbCritical + vbApplicationModal, "Ошибка"
  Exit Sub
End Sub

[stas_org]

Вертикальные линии по ГОСТу толще горизонтальных, имхо в таблицах невозможно, если я не ошибаюсь.

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

Можно. Смотри внимательно код.

[stas_org]

Ну да ладно, Алексей а ты ПГСник, если до, то хотелось бы услышать твое авторитетное мнение по поводу http://dwg.ru/dnl/4412 и Vildar тоже. прошу прошения что не в теме, автор молчит.

[Vildar]

Если тебе этот макрос помогает ускорить работу, то он хороший

Еще бы графики добавить. Например выделил чертеж с арм.изделиями в виде блоков например и получил спецификацию и выборку.

Я например считаю арматуру ростверка. Все арматурные элементы (каркасы, сетки, стержни) в виде блоков с уникальными именами. Характеристики арм.элементов определяются по имени блока и дополнительно в диалоговом режиме. Ну и выдается ведомость арм. элементов ростверка, спецификации каркасов, сеток и выборка арматуры. Когда я пришел, мне эту фигню дали в рукопашную считать - несколько дней ушло, и тут-то мысль об автоматизации промелькнула )))

Теперь хочу что-то подобное сделать и для ж.б. изделий панелей и плит (у нас панельные дома), пока не соображу что к чему. Думаю создать отдельную тему. - Хотя мне их считать пока не давали ) - тетки бедные мучаются ))

ЗЫ пороль не подобрал )))

[stas_org]

Меня интерисует твой опыт армированиния отдельными стержнями. Я так понял, каждый стержень- это блок, длинну (хоть она разная) можно определить, а вот класс, диаметр, или для каждой позиции блок надо. Я делалаю так: в опалубку в масштабе 1:1 расскладываю все стержни, затем копирую все, удаляю не нужные, и формирую рабочку. раскладку всей арматуры общитываю.

[Vildar]

В наших ростверках отдельных стержней мало, и причем в основном один и тот же - 20 А-III L=2000. Блок так и называется "Стержень20". Длина = отрезку. А класс один для всех стержней, задается в настройках (которые сохраняю в отдельном файле).

Тебе можно, например, по слоям раскидывать разные классы и диаметры стержней (хотя слоев может оказаться многовато)))).
А вообще-то, нужно под конкретные условия выполнения чертежей подстраиваться.
Ну а если сам себе голова, то ляпота, можно все подстраивать под программу.

[stas_org]

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

[Vildar]

За Алексеем таково не замечалось, всегда пожалста )))

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

stas_org, я не использую расширенные данные. Принципиально

[vasyavip]

Прошу прощения, но интернета у меня на работе нет. Могу только из дома.
Вот прикладываю то, что еще понаделал.

Вопрос: "как округлить число до двух знаков после запятой"?
Да и еще! Я хотел установить мою программу на другом компьютере, но там она расползлась по экрану и ничего стало не понятно!

Для Алексея! aka kpblc!
Немог ли ты показать пример кода создания анонимного блока, как его подвязать к моей таблице? Хотя бы к первым 10 строкам!
Надеюсь и уверен, что это будет интерестно всем!
Кстати, Алексей! нельзя ли в Vba добавить код LISP'а, ведь там наверняка можно вставлять кучу объектов туда, куда надо!
И если эток код сделать унивессальным? Чтобы его присоединять куда захочешь?? А-а??

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

vasyavip, а ты код вообще-то смотрел?

Код:

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

' Теперь создаем анонимный блок
  Dim blkDef As AcadBlock, BasePoint(2) As Double
  BasePoint(0) = 0#: BasePoint(1) = 0#: BasePoint(2) = 0#
  Set blkDef = ThisDrawing.Blocks.Add(BasePoint, "*U")
  ' Вставляем в него таблицу
  Dim objTable As AcadTable
  Set objTable = blkDef.AddTable(BasePoint, 3, 5, 5, 10)

"Как округлить..." - см. Round
"Хотел установить..." - значит, надо менять логику создания формы и переводить позиционирование контролов на "динамический" код.
"Добавить код LISP'a в VBA" или наоборот - этот вопрос уже поднимался. И не раз. И решался тож
"Вставлять кучу объектов" куда угодно в общем-то можно и через VBA, и через lisp, и через .NET, и через ObjectARX. Вопрос не понял.

[Александр Бауск]

Сообщение от stas_org Ну да ладно, Алексей а ты ПГСник, если до, то хотелось бы услышать твое авторитетное мнение по поводу http://dwg.ru/dnl/4412 и Vildar тоже. прошу прошения что не в теме, автор молчит.

Как минимум одна серьезная ошибка:
1. Нет инсталлятора.

[Александр Бауск]

Сообщение от Кулик Алексей aka kpblc stas_org, я не использую расширенные данные. Принципиально

Ик... А как же вы живете?

[vasyavip]

Кулик Алексей aka kpblc
А как теперь эту таблицу, после вставки взорвать? Програмно!

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

Александр Бауск, а так и живем Используем (мы, Божией милостью государь всея Руси...) либо словари, либо ldata. Очень удобственно, доложу я вам
vasyavip, а я из вредности опять отправлю в #18 на предмет анализа кода.

[vasyavip]

Vildar
rtyuehe159263487
если об этом!
З.Ы.
Он ко всем приложенным файлам!

aka kpblc
Код проанализировал, понял что там что-то есть и надо использовать метод 'Explode'
но пока как подступиться я не понял.

objTable.AcadTable = Explode не выходит!

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

vasyavip, лично я ни капли не понял последней строки. Переведи.

[vasyavip]

aka kpblc
Я имел ввиду, что надо после вставки таблицы ее взорвать! Как это сделать??

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

[Александр Бауск]

Остановите самолет, я сойду.
А у этих ldata, о которых я только что узнал, есть какие-нибудь преимущества по сравнению с XData?

А то бешеной собаке семь верст не крюк - глядишь, сделаю обертку для работы из-под VBA.

>vasyavip
Только через SendCommand.

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

vasyavip, а я тебя еще раз отправлю к коду. Там это сделано.
Александр Бауск, я уже не помню точно, почему я сделал ставку именно на ldata (чтение и запись выполняются через vlax-ldata-get и vlax-ldata-put соответственно). Да и привык я к ним. А словари использую для глобальных вещей, на весь файл.
Расширенные данные (которые в лиспе идут после группы -3) слишком ограниченны, да и при обработке файла Express'овскими командами могут порождать проблемы. У ldata такого не замечал.

[Александр Бауск]

Спасибо. Гляну.

[vasyavip]

aka kpblc
Если отойти от таблицы и придти, например к созданию линии разрыва. Это я могу сделать, как мне эту ломаную полилинию вставить не в 0,0,0, а туда, куда я хочу.
Я могу написать код , по которому будет чертиться лист по ГОСТ формата всех "А", с выбором в диалоговом окне, какой размер нужен, нужно ли добавить штамп согласования, пока не могу предоставить пользователю возможность заполнить штамп, так как не знаю как вставить текст, вернее как его уместить в рамках ячеек, с нужными параметрами:
высоты, толшины, ширины и т.д.
Есть у меня задумка реализовать в диалоговом режиме проектирование колонны:
1. сечение колонны
2. высота колонны
3. армирование на 1 этаж или на 2 этажа
4. диалоговый режим:
а)защитный слой
б)если защитный слой более 55 мм, то предложить по периметру сетку
в)если сетка необходима, ее подбор и калькуляция
5. конструирование арматуры:
а)сколько стержней по одной стороне?
б)их диаметр
в)если стержни хомутообразующие и средние различного диаметра, то их диаметры и расположение
г)если промежуточные (средние) стержни существуют, то установка гнутых стержней на них или еще одного ромбовидного хомута(!)
-Здесь возникает дилема: как задать программно радиус закругления гнутого стержня при изменении геометрии от угла в 90 градусов к острому
д)конструирование основного хомута
6. Выдача спецификации
7. Выдача ведомости расхода стали
8. выдача ведомости деталей по выбранным параметрам

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

З.Ы.
Такая вот задумка
З.Ы. 2
Слов "ДЕРЗАЙ" для осуществления этого недостаточно!
Нужно содействие, а меня отпихивают в дебри!!!
Кто-нибудь дайте пример реального кода, как кучу линий вставить туда, куда выберет пользователь!
Если будут предложения по задумке программы для колонны пишите!
Те макросы, что выложил выше, пожалуйста, критикуйте!
Буду рад!

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

Во написал-то!

Сообщение от vasyavip aka kpblc Если отойти от таблицы и придти, например к созданию линии разрыва. Это я могу сделать, как мне эту ломаную полилинию вставить не в 0,0,0, а туда, куда я хочу.

Учись анализировать код. Без этого ничего не добьешься.
Я ж тебе расписал, как вставлять что угодно куда угодно. На примере таблицы не катит? А посмотреть метод AddLightWeightPolyline религия не позволяет?

Сообщение от vasyavip Я могу написать код , по которому будет чертиться лист по ГОСТ формата всех "А", с выбором в диалоговом окне, какой размер нужен, нужно ли добавить штамп согласования, пока не могу предоставить пользователю возможность заполнить штамп, так как не знаю как вставить текст, вернее как его уместить в рамках ячеек, с нужными параметрами: высоты, толшины, ширины и т.д.

Одно из двух - либо ты используешь таблицу сложного форматирования, либо программно создаешь блок с атрибутами. Лично я в свое время пошел по второму пути - контролировать проще. А вопрос "умещения" атрибутов в нужные рамки решался постоянным анализом нужной строки и занимаемой ею области. Для работы с таблицей тебе придется дополнительно еще снимать форматирование многострочного текста и задавать ширину через ключ \W. Головняк...

Сообщение от vasyavip Есть у меня задумка реализовать в диалоговом режиме проектирование колонны:

Задумка хороша, кроме одного вопроса: а почему только колонны? А балку засобачить? А ферму? А плиту?

Сообщение от vasyavip -Здесь возникает дилема: как задать программно радиус закругления гнутого стержня при изменении геометрии от угла в 90 градусов к острому

Если у тебя будут использоваться полилинии, то надо будет (по идее) менять массив координат вершин и вычислять Bunlge (кажется, так правильное название).

Сообщение от vasyavip Я хочу вставить <...> в ту точку, которую захочу<...>

Да бога ради. Код тебе предоставлен. Создавай блок (анонимный или "нормальный" - по ситуации; вставляй. При необходимости разбивай и уничтожай исхходник.

Сообщение от vasyavip Я хочу вставить спецификацию туда, куда я хочу, хочу в пространстве модели, хочу в пространстве листа...

Ну пиши "перевод" на VBA кода http://www.arcada.com.ua/forum/viewtopic.php?t=486 - получай текущее пространство и вставляй чего хотишь.

Сообщение от vasyavip З.Ы. 2 Слов "ДЕРЗАЙ" для осуществления этого недостаточно! Нужно содействие, а меня отпихивают в дебри!!!

А какое тебе еще содействие надо? Все разжевать? Еще раз?

[vasyavip]

и ферму и плиту и много чего еще!
Просто помоги разобраться с кодом!
Покажи как его присоединить не к автокодовской таблице а к моей , то что в начале!
Ага, разжевать и с комментариями! ))

Вот не разберусь с кодом и будете вставлять, и балку, и ферму, и колонну, и хому ты, и каркасы на продавливание плиты, и дополнительную арматуру вокруг колонны в координаты 0,0,0
Бе-е-е

З.Ы.
\W. Головняк... - это фамилия автора идеи?

Почему никто не критикует мою спецификацию и расчет арматуры? Жду!

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

Етить твою нехай... Чего помогать-то?
OwnerObject.AddLightWeightPolyline - чего тут расшифровывать? OwnerObject - описание блока (пространство модели или листа - это тоже блок), в который вставляется что? Прааально, полилиния.
OwnerObject.AddLine - это для отрезка.
OwnerObject.AddText - для однострочного текста.
Тебе что, таким образом все примитивы перечислять?
С точки зрения программы (имею в виду нормальное решение) тебе бы стоило написать одну(!) функцию, создающую отрезок со всеми возможными параметрами. И вызывать ее по максимуму. В VBA не силен, да и спать уже хочется, поэтому на написание меня не хватает.

[stas_org]

2vasyavip

Dim нужнаяточкавставки As Variant
нужнаяточкавставки = ThisDrawing.Utility.GetPoint(, "Пояснение для юзверя")

можешь по Русски переменные объявлять

[stas_org]

нужнаяточкавставки- это массив от 0 до 2 который хранит координаты X,Y,Z точки которую ты указал используя #44

[stas_org]

Сообщение от vasyavip Почему никто не критикует мою спецификацию и расчет арматуры? Жду!

Кнопка РАСЧЕТ лишняя, события combobox_click было бы достаточно.

[vasyavip]

Спасибо разбираюсь с кодом! Есть зацепка, т.е. немного понял!
Спасибо за критику, постораюсь исправить!
Хочу к кнопке расчета добавить еще и спецификацию из textbox'ов.
Вопрос:
Как создать файл, в который можно записывать информацию из нескольких textbox'ов и потом считывать их от туда!
Это нужно для сохранности информации!

[stas_org]

Нужно организовать потоки streemread и streemwrite, много информации в инете имеется, советую отправиться в книжный магазин и купить книгу по VBA, всегда должна быть под рукой.

[Александр Бауск]

Купите книжку.

[vasyavip]

Код:

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

'*************************************************************************************************


'Сетка осей

'*************************************************************************************************
Private Sub CommandButton3_Click()
Dim lineObja As AcadLine
    Dim startPointa(0 To 2) As Double
    Dim endPointa(0 To 2) As Double
    
    startPointa(0) = Val(TextBox1.Text) + 0#: startPointa(1) = Val(TextBox1.Text) + Val(TextBox2.Text) + 0#: startPointa(2) = 0#
    endPointa(0) = Val(TextBox1.Text) + 0#: endPointa(1) = Val(TextBox3.Text) + 0#: endPointa(2) = 0#
    Set lineObja = ThisDrawing.ModelSpace.AddLine(startPointa, endPointa)
            
    Dim circleObj As AcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    
    ' Define the circle
    centerPoint(0) = Val(TextBox1.Text) + 0#: centerPoint(1) = Val(TextBox1.Text) + 0#: centerPoint(2) = 0#
    radius = Val(TextBox2.Text) + 0#
    
    ' Create the Circle object in model space
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
'***
    Dim lineObjc As AcadLine
    Dim startPointc(0 To 2) As Double
    Dim endPointc(0 To 2) As Double
    
    startPointc(0) = 100 + Val(TextBox2.Text) + 0#: startPointc(1) = Val(TextBox65.Text) + 0#: startPointc(2) = 0#
    endPointc(0) = Val(TextBox65.Text) + 0#: endPointc(1) = 100 + Val(TextBox2.Text) + 0#: endPointc(2) = Val(TextBox3.Text) + 0#
    Set lineObjc = ThisDrawing.ModelSpace.AddLine(startPointc, endPointc)
            
    Dim circleObjc As AcadCircle
    Dim centerPointc(0 To 2) As Double
    Dim radiusc As Double
    
    ' Define the circle
    centerPointc(0) = Val(TextBox65.Text) - 200 + 0#: centerPointc(1) = Val(TextBox65.Text) + 0#: centerPointc(2) = 0#
    radiusc = Val(TextBox2.Text) + 0#
    
    ' Create the Circle object in model space
    Set circleObjc = ThisDrawing.ModelSpace.AddCircle(centerPointc, radiusc)
'****

'****
'растиражируем линию
    Dim numberOfRows0 As Long
    Dim numberOfColumns0 As Long
    Dim numberOfLevels0 As Long
    Dim distanceBwtnRows0 As Double
    Dim distanceBwtnColumns0 As Double
    Dim distanceBwtnLevels0 As Double
    numberOfRows0 = 1 ' количество строк
    numberOfColumns0 = Val(TextBox6.Text) ' количество колонок
    numberOfLevels0 = 1
    distanceBwtnRows0 = 1 'расстояние между строк
    distanceBwtnColumns0 = Val(TextBox5.Text) 'расстояние между колонками
    distanceBwtnLevels0 = 1
    
    If TextBox5.Text <= 0 Then 'выполняем условие защиты выполнения программы от введенного "нуля"
    numberOfColumnsa = 1
    TextBox5.Text = 1
    End If
    If TextBox6.Text <= 0 Then 'выполняем условие защиты выполнения программы от введенного "нуля"
    distanceBwtnColumnsa = 500
    TextBox6.Text = 500
    End If
    ' чертим растиражированную линию
    Dim retObja As Variant
    retObja = lineObja.ArrayRectangular(numberOfRows0, numberOfColumns0, numberOfLevels0, distanceBwtnRows0, distanceBwtnColumns0, distanceBwtnLevels0)
     ' чертим растиражированный круг
    Dim retObjb As Variant
    retObjb = circleObj.ArrayRectangular(numberOfRows0, numberOfColumns0, numberOfLevels0, distanceBwtnRows0, distanceBwtnColumns0, distanceBwtnLevels0)
'****

'****
'растиражируем линию
    Dim numberOfRowsc As Long
    Dim numberOfColumnsc As Long
    Dim numberOfLevelsc As Long
    Dim distanceBwtnRowsc As Double
    Dim distanceBwtnColumnsc As Double
    Dim distanceBwtnLevelsc As Double
    numberOfRowsc = Val(TextBox36.Text) ' количество строк
    numberOfColumnsc = 1 ' количество колонок
    numberOfLevelsc = 1
    distanceBwtnRowsc = Val(TextBox35.Text) 'расстояние между строк
    distanceBwtnColumnsc = 1 'расстояние между колонками
    distanceBwtnLevelsc = 1
    
    If TextBox5.Text <= 0 Then 'выполняем условие защиты выполнения программы от введенного "нуля"
    numberOfColumnsc = 1
    TextBox5.Text = 1
    End If
    If TextBox6.Text <= 0 Then 'выполняем условие защиты выполнения программы от введенного "нуля"
    distanceBwtnColumnsc = 500
    TextBox6.Text = 500
    End If
    ' чертим растиражированную линию
    Dim retObjc As Variant
    retObjc = lineObja.ArrayRectangular(numberOfRowsc, numberOfColumnsc, numberOfLevelsc, distanceBwtnRowsc, distanceBwtnColumnsc, distanceBwtnLevelsc)
     ' чертим растиражированный круг
    Dim retObjd As Variant
    retObjd = circleObj.ArrayRectangular(numberOfRowsc, numberOfColumnsc, numberOfLevelsc, distanceBwtnRowsc, distanceBwtnColumnsc, distanceBwtnLevelsc)
'****

    UserForm1.Hide
    
End Sub

Почему сетка не чертится как надо?
Как сделать так, чтобы можно было изменять количество и шаг у осей в диалоговом режиме?
Если можно, подправьте мой код!

[stas_org]

скинь весь проект *.dvb

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

В качестве рац.предложения (которое практически гарантированно принято не будет): создавать блок с атрибутом обозначения оси и устанавливать его.
P.S. Основной код смотрел "по диагонали".

[Александр Бауск]

>Почему сетка не чертится как надо?

А как надо?

[vasyavip]

Вот весь проект по сеткам!
Что там не так?
Почему не чертит, как надо??

[Александр Бауск]

Потому что сделан криво.
Пользуйтесь дебаггером.

[stas_org]

Зачем val ? Их надо в Double преобразовывать, ни одного цикла не заметил, честно говоря без них подобный алгоритм не представляю. Ну и без дебагера никуда. С нужнойточкойвставки так и не разобрался?

[vasyavip]

ПОка нет. Вот, на работе завалили! Я постараюсь вставить код полилинии в так код, который алексей показал.
А с начала, наверное, сделаю форматку разных размеров и направлений (альбомная и книжная). Хчу сделать их в диалоговом режиме, чтоб пользователь выбирал сам, и еще, чтоб он выбирал, надо ли ему штамп согласования и сколько штук!
А так взял работу на дом. Нет, чтоб отдыхать... работа, блин, работа...

[stas_org]

Прямо Наполеоновские планы. Больше толку будет если что-нибудь одно до ума довести.

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

vasyavip, погляди в download - там добра этого (форматок то бишь) завались. И без программирования

[stas_org]

Мартышкин труд делает инженера

[vasyavip]

Алексей aka kpblc - а поучиться?

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

vasyavip, #61 - это про программное создание форматок?

[vasyavip]

Именно так!

[vasyavip]

Я хочу реализоваь программу для автоматического конструирования колонны. Это та цель, которая вдохновляет!

[vasyavip]

Я зашел к нашим разрабодчикам када
http://discussion.autodesk.com
как у них там хило с инфой.
Наш форум гораздо профессиональнее и более информативный.
Явно они dwg.ru у себя, как домашнюю страницу загружают!

[vasyavip]

Вот, что еще понаделал.
Вопрос:
диаметр опавки правильный или надо половину, т.е. не 8 диаметров а 8 радиусов?

[vasyavip]

АУ! Коллеги, прокомментируйте прогу!

Да! Ура, у меня получилось вставить линию разрыва туда, куда я хотел, только вот не понял, как мне эту полилинию повернуть и растянуть.

[vasyavip]

Алексей aka kpblc, а как сделать так, чтобы линии чертилить на заданное расстояние друг от друга (по примеру осей) и чтобы можно было менять расстояние между линиями.
Да и еще, как между ними еще и размеры провести?

[Александр Бауск]

Только чур, не обижаться.
Программу такую я бы до пользователей не доводил.
"Синие" поля на эскизе, оказывается, можно менять. Это так надо или так не надо? Писать туда можно любую белиберду, в том числе буквы.
Алгоритм вообще непонятен. Ввожу одно, он самовольно что-то изменяет, справа, как вдруг выясняется, оказываются результаты.

Ошибки не отлавливаются вообще, как я вижу. Нет, к пользоватлям такую программу пускать нельзя.

Ну и самое главное: почему это вообще реализовано в VBA? Самый неподходящий инструмент.

[vasyavip]

Александр Бауск, а как запретить вводить буквы и спецсимволы?
А насчет правой части - это и правда результат!
Как сделать ее лучше?
Код ведь открыт. Или таки е программы не нужны пользователям? А ее делал, чтобы научиться работать в vba. Моя первоначальная задумка - это в диалоговом режиме спросить у пользователя, что ему надо и начертить это!

[Александр Бауск]

1. Нужно вообще не использовать textbox, для этого есть просто label.

2. О чем я и говорю - программа лично для меня работает неочевидно. Хорошо, если автор будет стоять за плечом и объяснять, что куда вводить. Но так же не всегда бывает.

3. Если приложение чтоб научиться - тогда тут вообще не в коде дело, а в правильном проектировании пользовательского интерфейса.

4. Чтобы научиться работать в VBA, надо работать с тем самым ценным, что в нем есть (кроме возможности рисовать удобные интерфейсы) - с объектной моделью хозяйского приложения, то есть Автокада.

5. Насчет полезности пользователям. По формулам можно и на калькуляторе посчитать. Смысл какой программы этой, смысл?
Такие приложения на ура пишутся в Excel, откуда результат можно сразу красиво распечатать. Кстати, на том же VBA.
И при этом не держать целый Автокад и не подключать мучительно dvb.

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

vasyavip, похоже, я опоздал с попыткой "разбора" кода. Только что скачал - проект защищен паролем.

[vasyavip]

rtyuehe159263487 - пароль на все программы

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

В качестве рекомендаций по коду (для оценки работы программы надо понимать, что она делает. У меня этого понимания нет.):
1. Контролам давать более информативные имена, чем CommanButton163 и TextBox654789 (утрирую, но все же...)
2. Я бы изменил интерфейс: вычисляемые значения - в Labels (см.71); вводимые поля - выделить визуально. Кнопку [Результат], может, будет иметь смысл перенести вне Tab
3. Помимо собственно вычисления надо что-то, что "перебьет" желание сделать аналогичное в Excel'e
4. Смысл защиты проект паролем от меня как-то ускользает...

[vasyavip]

Алексей aka kpblc
как начертить линию или группу объектов, ее программно выделить и сместить ее копию на расстояние введенное пользователем?

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

После выполнения кода типа ThisDrawing.ModelSpace.AddLine возвращается указатель на созданный отрезок. Ну и подставляй его в метод Copy - делов-то...

[vasyavip]

Алексей, поподробнее, не понял?!

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

Это как "подробнее"?

Код:

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

Option Explicit
Option Base 0

Sub Example_AddLine()
    ' This example adds a line in model space
    
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    
    ' Define the start and end points for the line
    startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#
    endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#
    
    ' Create the line in model space
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    
    Dim copyObj As AcadLine
    Set copyObj = lineObj.Copy
    
    Dim ptStartMove(2) As Double, ptEndMove(2) As Double
    ptStartMove(0) = 1#: ptStartMove(1) = 1#: ptStartMove(2) = 0#
    ptEndMove(0) = 10#: ptEndMove(1) = -1#: ptEndMove(2) = -10#
    copyObj.Move ptStartMove, ptEndMove
    copyObj.color = 1
End Sub