Obyektlərin yerinin dıyişdirilməsi Move komandası
Sub MoveCircle()
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 100#: center(1) = 120#: center(2) = 0#: radius = 20#
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomExtents
' Yerdəyişmə üçün 1-ci və 2-ci nöqtələr daxil edilir.20 vahid sağa
Dim point1(0 To 2) As Double,point2(0 To 2) As Double
point1(0) = 100: point1(1) = 120: point1(2) = 0
point2(0) = 120: point2(1) = 120: point2(2) = 0
circleObj.Move point1, point2
circleObj.Update
End Sub
line.Rotate BasePoint, rotAngle - obyekt döndərir.
line.Offset distance – oxşarını yaradır (distance müsbət olarsa solda, mənfi olduqda isə sağ tərəfdə oxşar fiqur yaradılır)
İki xəttin kəsişmə nöqtəsi
Sub Example_IntersectWith()
' Bu nümunədə Çevrə və düz xətt qurulub onların kəsişmə nöqtələri tapılır
' Düz xətt çəkilir
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
' Çevrə çəkilir
Dim circleObj As AcadCircle
Dim centerPt(0 To 2) As Double
Dim radius As Double
centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
ZoomAll
' Düz xətlə çevrənin kəsişmə nöqtələri tapılır
Dim intPoints As Variant
intPoints = lineObj.IntersectWith(circleObj, acExtendNone)
' Kəsişmə nöqtələrinin hamısı çap olunur
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If
End Sub
Sub ArrayingACircle()
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double, radius As Double
center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomExtents
Polyar çoxaltma ArrayPolar komandası
Sub ArrayingACircle()
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double, radius As Double
center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomExtents
' Pollyar massiv daxil edilir
Dim noOfObjects As Integer
Dim angleToFill As Double
Dim basePnt(0 To 2) As Double
noOfObjects = 4
angleToFill = 2*3.14 ' 360 dərəcə
basePnt(0) = 4#: basePnt(1) = 4#: basePnt(2) = 0#
' Mərkəz (3,3,0)ətrafında fırlatmaqla 4 ədəd çevrə yaradırıq
Dim retObj As Variant
retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)
ZoomExtents
EndSub
3d obyektlər
Üçölçülü bərk obyektlərin siyahısı.
AddBox, AddCone, AddCylinder, AddEllipticalCone, AddEllipticalCylinder, AddExtrudedSolid, AddExtrudedSolidAlongPath, AddRevolvedSolid, AddSolid, AddSphere, AddTorus, AddWedge. Məsələn:
Sub CreateWedge()
Dim wedgeObj As Acad3DSolid
Dim center(0 To 2) As Double
Dim length As Double
Dim width As Double
Dim height As Double
center(0) = 5#: center(1) = 5#: center(2) = 0
length = 10#: width = 15#: height = 20#
Set wedgeObj = ThisDrawing.ModelSpace.AddWedge(center, length, width, height)
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
Dostları ilə paylaş: |