AddLightWeightPolyline- ikiölçülü polixətt çəkir. Məsələn,
Sub AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
' Polixəttin təpə nöqtələri
points(0) = 20: points(1) = 40
points(2) = 40: points(3) = 20
points(4) = 60: points(5) = 40
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
ThisDrawing.Application.ZoomExtents
End Sub
3. AddArc- mərkəz nöqtəsi, radius, başlanğıc bucaq və son bucaqla qövs çəkir. Bucaq radianla daxil edilir.
Dim p1(0 To 2) As Double
Dim arc As AcadArc
Dim rad As Double
Dim basBucaq As Double, bucaq As Double
p1(0) = 0#: p1(1) = 0#: p1(2) = 0# 'merkez
basBucaq = 0#
bucaq = 1.7: rad = 30#
Set arc = ThisDrawing.ModelSpace.AddArc(p1, rad, basBucaq, bucaq)
4. AddCircle - mərkəz nöqtəsi və radiusla çevrə çəkir.
Dim p1(0 To 2) As Double
Dim cev As AcadCircle
Dim rad As Double
p1(0) = 0#: p1(1) = 0#: p1(2) = 0#: rad = 30#
Set cev = ThisDrawing.ModelSpace.AddCircle(p1, rad)
5. AddHatch- konturu ştrixləyir.
Sub CreateHatch()
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
patternName = "ANSI31" ' ştrixin adı
PatternType = 0
bAssociativity = True
' Ştrix konturu yaradır
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
hatchObj.PatternSpace = hatchObj.PatternSpace * 2# 'Ştrix arası məsafə
' Xarici kontur yaradır
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 = 30
Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
ThisDrawing.Regen True
ZoomAll
End Sub
6. AddRegion- region yaradır. Bir konturlu sadə regionun yaradılması
Sub CreateRegion()
' Regionun sərhəddi yaradılır
Dim curves(0 To 0) As AcadCircle
' Çevrəni regionun sərhəddi kimi yaradırıq
Dim center(0 To 2) As Double, radius As Double
center(0) = 2: center(1) = 2: center(2) = 0: radius = 50#
Set curves(0) = ThisDrawing.ModelSpace.AddCircle (center, radius)
' İndi isə regionun özü
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
ZoomExtents
End Sub
İki konturlu region
Sub CreateCompositeRegions()
Dim RoomObjects(0 To 1) As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 4: center(1) = 4: center(2) = 0: radius = 2#
Set RoomObjects(0) = ThisDrawing.ModelSpace.AddCircle(center, radius) ` xarici kontur üçün
radius = 1#
Set RoomObjects(1) = ThisDrawing.ModelSpace.AddCircle(center, radius) ` daxili kontur üçün
Dim regions As Variant
regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)
' dəyişənə mənimsədək
Dim RoundRoomObj As AcadRegion, PillarObj As AcadRegion
If regions(0).Area > regions(1).Area Then ` regionların sahəsi müqaisə olunur
' birinci
Set RoundRoomObj = regions(0)
Set PillarObj = regions(1)
Else
Set PillarObj = regions(0)
Set RoundRoomObj = regions(1)
End If
' rəngləmə
RoundRoomObj.Color = acRed
PillarObj.Color = acCyan
ZoomExtents
' böyükdən kiçiyi çıxırıq
RoundRoomObj.Boolean acSubtraction, PillarObj
MsgBox "Sahəsi: " & RoundRoomObj.Area
End Sub
Dostları ilə paylaş: |