[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]

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