Тема: Штриховка объектов
Здравствуйте Господа! Вопрос: нужно заштриховать область в AutoCadе, ограниченную полилинией, как это сделать средствами VBA Excel? Заранее благодарен.
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Штриховка объектов
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте Господа! Вопрос: нужно заштриховать область в AutoCadе, ограниченную полилинией, как это сделать средствами VBA Excel? Заранее благодарен.
Вопрос: нужно заштриховать область в AutoCadе, ограниченную полилинией, как это сделать средствами VBA Excel
Да никак! В Excel разве что dxf можно открыть и там чего-нибудь наваять:)
А если Вы имеете в виду получить из Excel доступ к открытому в Автокаде чертежу, то как-нибудь так:
Set Cad = GetObject(, "AutoCad.Application")
И потом делаете в Cad.ActiveDocument.ModelSpace что хотите, через объектную модель Автокада, естесственно:)
Автокад я открыл через эксель, опять же через зксель средствами Автокада начертил все что надо, для окончательного оформления недостает только заштриховать некоторые области, а помощи автокадовской я не смог разобраться. Мне б примерчик штриховки VBA...
Да что ж там сложного-то? Вот же простенький пример из того же хелпа:
Sub Example_AddHatch() ' This example creates an associative gradient hatch in model space. Dim hatchObj As AcadHatch Dim patternName As String Dim PatternType As Long Dim bAssociativity As Boolean ' Define the hatch patternName = "CYLINDER" PatternType = acPreDefinedGradient '0 bAssociativity = True ' Create the associative Hatch object in model space Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity, acGradientObject) Dim col1 As AcadAcCmColor, col2 As AcadAcCmColor Set col1 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16") Set col2 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16") Call col1.SetRGB(255, 0, 0) Call col2.SetRGB(0, 255, 0) hatchObj.GradientColor1 = col1 hatchObj.GradientColor2 = col2 ' Create the outer boundary for the hatch (a circle) Dim outerLoop(0 To 0) As AcadEntity Dim center(0 To 2) As Double Dim radius As Double center(0) = 3: center(1) = 3: center(2) = 0 radius = 1 Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius) ' Append the outerboundary to the hatch object, and display the hatch hatchObj.AppendOuterLoop (outerLoop) hatchObj.Evaluate ThisDrawing.Regen True End Sub
Обратите внимание на вот эту тонкость:
hatchObj.AppendOuterLoop (outerLoop)
В том же хелпе есть примечание:
WARNING! Once the Hatch object has been created, you must append the outer loop to the Hatch object for it to become a valid AutoCAD object. If you attempt any operation other than calling the AppendOuterLoop method, AutoCAD will enter an unpredictable state.
То бишь сначала создаем штриховку, а потом ограничиваем ее при помощи методов AppendOuterLoop и AppendInnerLoop.
Сам не занимался, но в хелпе вроде все доходчиво рассказано и даже работает!:)
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Штриховка объектов
Форум работает на PunBB, при поддержке Informer Technologies, Inc