[Kostia8_8]

Добрый день. Как следует из названия темы,есть прямоугольник и нужно скруглить ему углы Подскажите,пожалуйста,как это сделать с помощью VBA?

[AlexV]

Код:

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

Sub main()
ThisDrawing.SendCommand "._fillet" & vbCr
End Sub

[Олег (jr.)]

Сообщение от Kostia8_8 Добрый день. Как следует из названия темы,есть прямоугольник и нужно скруглить ему углы Подскажите,пожалуйста,как это сделать с помощью VBA?

Точнее наверное так

Код:

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

Sub FilletPolyline()
    Dim ent As AcadEntity
    Dim pt As Variant
    Dim pline As AcadLWPolyline
    Dim rad As Double
    rad = 10#
  
    With ThisDrawing
        .Utility.GetEntity ent, pt, vbLf & "Select rectangle: "
        If TypeOf ent Is AcadLWPolyline Then
            Set pline = ent
        Else
            Exit Sub
            End If
            .SetVariable "cmdecho", 0
            .SetVariable "filletrad", rad  '<--fillet radius
            .SendCommand "._fillet _P (handent " & Chr(34) & ent.Handle & Chr(34) & ")" & vbCr
            .SetVariable "cmdecho", 1
        End With
        
    End Sub

~'J'~

[Kostia8_8]

Олег (jr.) , как я понял здесь вручную надо выбрать объект,а можно ли сделать так,чтобы все на автомате делалось. Т.е. с помощью вба создается прямоугольник,автоматически выбирается и ему скругляют углы?
П.с. ели что-то неправильно понял,простите)

[Олег (jr.)]

Сообщение от Kostia8_8 Олег (jr.) , как я понял здесь вручную надо выбрать объект,а можно ли сделать так,чтобы все на автомате делалось. Т.е. с помощью вба создается прямоугольник,автоматически выбирается и ему скругляют углы? П.с. ели что-то неправильно понял,простите)

Тогда тебе проще сразу вычислить координаты всех 8-ми точек

исходя из размеров и радиуса скругления

Это элементарная арифметика, извини

Под рукой примеров нет так же как и свободного времени

~'J'~

[Kostia8_8]

Сообщение от Олег (jr.) Тогда тебе проще сразу вычислить координаты всех 8-ми точек исходя из размеров и радиуса скругления Это элементарная арифметика, извини Под рукой примеров нет так же как и свободного времени ~'J'~

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

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

Kostia8_8, ты лучше разберись с объектом LightWeightPolyline и заданием его свойств...

[Олег (jr.)]

Сообщение от Kostia8_8 С арифметикой проблем нет,вычислю)) т.е. надо будет аркой рисовать скругления? без прямоугольника?

Посмотри в Help'e метод SetBulge там должен быть пример
Нашел в своих загашникахЖ

Код:

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

Option Explicit

Const bulg As Double = 0.414213562373095 '<-- tangent pi/8
Public Sub DrawFilletedRectang()
' 23/03/08

Dim p As Variant
Dim rad As Double
Dim leng As Double
Dim wid As Double
leng = 6000# 'length
wid = 3000# 'height
rad = 200# 'radius

Dim oPline As AcadLWPolyline
Dim pts(0 To 17) As Double
p = ThisDrawing.Utility.GetPoint(, "Pick center point of rectangle:")
pts(0) = p(0) - leng / 2 + rad: pts(1) = p(1) - wid / 2
pts(2) = pts(0) + leng - 2 * rad: pts(3) = pts(1)
pts(4) = pts(2) + rad: pts(5) = pts(3) + rad
pts(6) = pts(4): pts(7) = pts(1) + wid - rad
pts(8) = pts(2): pts(9) = pts(7) + rad
pts(10) = pts(0): pts(11) = pts(9)
pts(12) = pts(10) - rad: pts(13) = pts(7)
pts(14) = pts(12): pts(15) = pts(5)
pts(16) = pts(14): pts(17) = pts(1) + rad
Set oPline = ThisDrawing.ActiveLayout.Block.AddLightWeightPolyline(pts)
With oPline
.Closed = True
.color = acMagenta
.Lineweight = acLnWt050
.SetBulge 1, bulg
.SetBulge 3, bulg
.SetBulge 5, bulg
.SetBulge 8, bulg
.Update
End With

End Sub

~'J'~

[Kostia8_8]

Спасибо)) разобрался

[Олег (jr.)]

Сообщение от Kostia8_8 Спасибо)) разобрался

Так-то оно лучше

~'J'~