ADN Club > AutoLisp / VisualLISP и DCL

Победа штриховки надо мной

<< < (2/8) > >>

Peacemaker_kiss:

--- Цитата: Александр Ривилис от 19-10-2014, 01:05:50 ---Задача должна сводиться к попытке получения контура (границы) штриховки на основе данных штриховки, а затем получение площади этой границы.
--- Конец цитаты ---
Да я это прекрасно понимаю, но вот как это сделать, странно, что нет инструмента такого встроенного в автокад! Было бы очень удобно...В идеале да нужно чтобы была команда, которая обрисовывает контур блока, и затем конечно брать площадь этой полилинии замкнутой. Но я не имею, пока, такой квалификации, чтобы написать такой макрос

trir:

--- Цитировать ---object.GetLoopAt Index, Loop

Object

Hatch
 The object or objects this method applies to.

Index

Integer; input-only
 A positive integer beginning with 0.

Loop

Variant (object or array of objects); output-only
 An object or array of objects that makes up the loop.

--- Конец цитаты ---


--- Код - Visual Basic [Выбрать] ---Sub Example_GetLoopAt()        ' This example creates an associative hatch in model space.        ' It then finds the objects that make up the first loop of the hatch.         Dim hatchObj As AcadHatch        Dim patternName As String        Dim PatternType As Long        Dim bAssociativity As Boolean         ' Define the hatch        patternName = "ANSI31"        PatternType = 0        bAssociativity = True         ' Create the associative Hatch object        Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)         ' Create the outer loop for the hatch.        ' An arc and a line are used to create a closed loop.        Dim outerLoop(0 To 1) As AcadEntity        Dim center(0 To 2) As Double        Dim radius As Double        Dim startAngle As Double        Dim endAngle As Double        center(0) = 5: center(1) = 3: center(2) = 0        radius = 3        startAngle = 0        endAngle = 3.141592        Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)        Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)                ' Append the outer loop to the hatch object        hatchObj.AppendOuterLoop (outerLoop)         ' Append the first circle as one inner loop        Dim innerLoop1(0) As AcadEntity        center(0) = 5: center(1) = 4.5: center(2) = 0        radius = 1        Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)        hatchObj.AppendInnerLoop (innerLoop1)         ' Append the second circle as the other inner loop        Dim innerLoop2(0) As AcadEntity        radius = 0.5        Set innerLoop2(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)        hatchObj.AppendInnerLoop (innerLoop2)         ' Evaluate and display the hatch        hatchObj.Evaluate        ThisDrawing.Regen True         ' Find the objects that make up the first loop        Dim loopObjs As Variant        hatchObj.GetLoopAt 0, loopObjs         ' Find the types of the objects in the loop        Dim I As Integer        Dim objName As String        objName = ""        For I = LBound(loopObjs) To UBound(loopObjs)                objName = objName & loopObjs(I).EntityName & ", "        Next         MsgBox "The objects in the first loop of the hatch are: " & objName, , "GetLoopAt Example"         End Subhttp://entercad.ru/acadauto.en/

Peacemaker_kiss:

--- Цитата: trir от 20-10-2014, 12:38:53 ---
--- Цитировать ---object.GetLoopAt Index, Loop

Object

Hatch
 The object or objects this method applies to.

Index

Integer; input-only
 A positive integer beginning with 0.

Loop

Variant (object or array of objects); output-only
 An object or array of objects that makes up the loop.

--- Конец цитаты ---


--- Код: ---Sub Example_GetLoopAt()
' This example creates an associative hatch in model space.
' It then finds the objects that make up the first loop of the hatch.

Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean

' Define the hatch
patternName = "ANSI31"
PatternType = 0
bAssociativity = True

' Create the associative Hatch object
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

' Create the outer loop for the hatch.
' An arc and a line are used to create a closed loop.
Dim outerLoop(0 To 1) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
center(0) = 5: center(1) = 3: center(2) = 0
radius = 3
startAngle = 0
endAngle = 3.141592
Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)

' Append the outer loop to the hatch object
hatchObj.AppendOuterLoop (outerLoop)

' Append the first circle as one inner loop
Dim innerLoop1(0) As AcadEntity
center(0) = 5: center(1) = 4.5: center(2) = 0
radius = 1
Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
hatchObj.AppendInnerLoop (innerLoop1)

' Append the second circle as the other inner loop
Dim innerLoop2(0) As AcadEntity
radius = 0.5
Set innerLoop2(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
hatchObj.AppendInnerLoop (innerLoop2)

' Evaluate and display the hatch
hatchObj.Evaluate
ThisDrawing.Regen True

' Find the objects that make up the first loop
Dim loopObjs As Variant
hatchObj.GetLoopAt 0, loopObjs

' Find the types of the objects in the loop
Dim I As Integer
Dim objName As String
objName = ""
For I = LBound(loopObjs) To UBound(loopObjs)
objName = objName & loopObjs(I).EntityName & ", "
Next

MsgBox "The objects in the first loop of the hatch are: " & objName, , "GetLoopAt Example"

End Sub
--- Конец кода ---
http://entercad.ru/acadauto.en/

--- Конец цитаты ---
Я побоюсь спросить, к чему бы это?

trir:
У штриховки есть метод GetLoopAt - который позволяет получить контуры

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

--- Цитата: Peacemaker_kiss от 20-10-2014, 11:08:15 ---    Дальше поговорим.

Придется дальше разговаривать! Не нашел макрос площадь
--- Конец цитаты ---

Выкладывай чертеж (dwg-файл) с одной этой штриховкой. Попробую понять почему не считается её площадь и не баг ли это.

Навигация

[0] Главная страница сообщений

[#] Следующая страница

[*] Предыдущая страница

Перейти к полной версии