[Valerija]

Всем Доброй Ночи, Утра, либо Дня.
С программирование да и с автокадом я еще новичок, только учусь. Есть такая програмка, которая должна работать на Бейсике. Человек вводить данные, по которым автоматически рисуется треугольник, и также програмка просит ввести радиус окружности..
После, пользователь жмет на кнопочку и наш треугольник заполняетсяокружностями с заданным радиусом.

Может у кого есть какие идейки как это реализовать, была бы очень благодарна..

Как нарисовать трегольник, я придумала... окружности тоже вписываются, только они вписываются у меня неправильно.. Не знаю что делать
Зараннее всем спасиьбо.

Код работающий, выглядит так:

Код:

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

Private Sub CommandButton1_Click()
Me.Hide
Dim i As Integer, j As Integer
Dim t1 As Variant
Dim t2(0 To 2) As Double
Dim t3(0 To 2) As Double
Dim t4 As Variant
Dim l As Double, ll As Double
Dim h As Double, hh As Double
Dim pt(0 To 7) As Double
Dim pp As AcadLWPolyline
Dim okruz As AcadCircle
Dim luc As Variant
Dim horiz As Double
Dim vert As Double
Dim cislo As Integer
Dim c(0 To 2) As Double

t1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Nacalnaja tocka diagonali t1: ")
t4 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Vtoraja tocka diagonali t4: ")

l = t4(0) - t1(0)
h = t4(1) - t1(1)

t2(0) = t1(0) + l: t2(1) = t1(1)

pt(0) = t1(0): pt(1) = t1(1)
pt(2) = t2(0): pt(3) = t2(1)
pt(4) = t4(0): pt(5) = t4(1)
pt(6) = t1(0): pt(7) = t1(1)

Set pp = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)
luc = ThisDrawing.Utility.GetReal("Vvedite radius okruznosti:): ")

horiz = l \ (luc * 2)            
vert = h \ (luc * 2)
cislo = horiz * vert
ll = 0
For i = 1 To horiz             
c(0) = t1(0) + luc + ll
hh = 0
For j = 1 To vert               
c(1) = t1(1) + luc + hh
Set okruz = ThisDrawing.ModelSpace.AddCircle(c, luc)
hh = hh + luc * 2
Next j
ll = ll + luc * 2
Next i

MsgBox "Cislo okruznostei: " & cislo
okruz.Update

Me.Show
End Sub

[fixo]

Так вроде должно работать:

Код:

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

Option Explicit

Private Sub CommandButton1_Click()
    Me.Hide
    Dim i As Integer, j As Integer, k As Integer
    Dim t1 As Variant
    Dim t2(0 To 2) As Double
    Dim t3(0 To 2) As Double
    Dim t4 As Variant
    Dim L As Double, ll As Double
    Dim h As Double, hh As Double
    Dim pt(0 To 7) As Double
    Dim pp As AcadLWPolyline
    Dim okruz As AcadCircle
    Dim apEnt(0) As AcadEntity
    Dim luc As Variant
    Dim horiz As Double
    Dim vert As Double
    Dim cislo As Integer
    Dim c(0 To 2) As Double

    t1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Nacalnaja tocka diagonali t1: ")
    t4 = ThisDrawing.Utility.GetPoint(t1, vbCrLf & "Vtoraja tocka diagonali t4: ")

    L = t4(0) - t1(0)
    h = t4(1) - t1(1)

    t2(0) = t1(0) + L: t2(1) = t1(1)

    pt(0) = t1(0): pt(1) = t1(1)
    pt(2) = t2(0): pt(3) = t2(1)
    pt(4) = t4(0): pt(5) = t4(1)
    pt(6) = t1(0): pt(7) = t1(1)

    Set pp = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)

    Dim oSset As AcadSelectionSet
    Dim rSset As AcadSelectionSet

    Dim oEnt As AcadEntity
    Dim rEnt As AcadEntity

    With ThisDrawing.SelectionSets
        While .Count > 0
            .Item(0).Delete
        Wend
        Set oSset = .Add("$ToFill$")
        Set rSset = .Add("$ToRemove$")
        oSset.Clear
        rSset.Clear
    End With

    luc = ThisDrawing.Utility.GetReal("Vvedite radius okruznosti:): ")
    Dim fType(0) As Integer
    Dim fData(0) As Variant

    fType(0) = 0
    fData(0) = "CIRCLE"

    Dim dxfCode, dxfValue
    dxfCode = fType: dxfValue = fData
    Dim mode As Integer
    mode = acSelectionSetWindowPolygon

    Dim cnt As Integer
    cnt = ThisDrawing.ModelSpace.Count
    horiz = L / (luc * 2)
    vert = h / (luc * 2)
    cislo = horiz * vert
    ll = 0
    For i = 1 To horiz
        c(0) = t1(0) + luc + ll
        hh = 0
        For j = 1 To vert
            c(1) = t1(1) + luc + hh
            Set okruz = ThisDrawing.ModelSpace.AddCircle(c, luc)
            Set apEnt(0) = okruz
            oSset.AddItems apEnt
            oSset.Update
            hh = hh + luc * 2
        Next j
        ll = ll + luc * 2
    Next i

    ThisDrawing.Regen acActiveViewport

    Dim rpoints(0 To 8) As Double
    rpoints(0) = t1(0): rpoints(1) = t1(1): rpoints(2) = 0#
    rpoints(3) = t2(0): rpoints(4) = t2(1): rpoints(5) = 0#
    rpoints(6) = t4(0): rpoints(7) = t4(1): rpoints(8) = 0#

    rSset.SelectByPolygon mode, rpoints, dxfCode, dxfValue
    If rSset.Count = 0 Then MsgBox "Foo, what's the smell?": GoTo exit_here

    Dim objs() As AcadEntity

    For j = rSset.Count - 1 To 0 Step -1
        Set oEnt = rSset.Item(j)
        For i = oSset.Count - 1 To 0 Step -1
            Set rEnt = oSset.Item(i)
            If StrComp(oEnt.Handle, rEnt.Handle, vbTextCompare) = 0 Then
                ReDim Preserve objs(k)
                Set objs(k) = rEnt
                k = k + 1
                Exit For
            End If
        Next i
    Next j

    oSset.RemoveItems objs
    oSset.Erase

exit_here:
    ThisDrawing.Regen acActiveViewport
    Exit Sub

    Me.Show
End Sub

~'J'~

[Valerija]

Хм, не пойму в чем проблема но код не запускается, ссылается на ошибку в Private Sub CommandButton1_Click()

[fixo]

Листинг исправлен
Забыл удалить неиспользуемый блок кода
Попробуй снова

~'J'~

[Valerija]

Вы герой.
Спасибо за помощь все работает...

[fixo]

Рад коли так и успехов

~'J'~