Public Function Dpp(P1, P2)

'oblicza odleglosc midzy 2 puntkami

If UBound(P1) = 2 And UBound(P2) = 2 Then

Dpp = Sqr((P2(0) - P1(0)) ^ 2# + (P2(1) - P1(1)) ^ 2# + (P2(2) - P1(2)) ^ 2#)

Else

Dpp = Sqr((P2(0) - P1(0)) ^ 2# + (P2(1) - P1(1)) ^ 2#)

End If

End Function

Public Function PLD(IP1, IP2, IDist)

'zwraca punkt (tablica współrzędnych) w określonej odległosci od 1 punktu w kierunku drugiego

distance = Dpp(IP1, IP2)

Dim TmpVec(2) As Double

If IDist = 0 Then

readyVec = IP1

Else

If distance > 0 Then

DispVec = Array(IP2(0) - IP1(0), IP2(1) - IP1(1), IP2(2) - IP1(2))

vecnor = Array(DispVec(0) / (distance / IDist), DispVec(1) / (distance / IDist), DispVec(2) / (distance / IDist))

readyVec = Array(IP1(0) + vecnor(0), IP1(1) + vecnor(1), IP1(2) + vecnor(2))

Else

readyVec = IP1

End If

End If

TmpVec(0) = readyVec(0): TmpVec(1) = readyVec(1): TmpVec(2) = readyVec(2)

PLD = TmpVec

End Function

Public Sub Krzyzyk()

Dim P1 As Variant

Dim P2 As Variant

P1 = ThisDocument.Utility.GetPoint(, "Wskaż punkt: ")

P2 = ThisDocument.Utility.GetPoint(P1, "Wskaż punkt: ")

Dim lineObj1 As ZwcadLine

Set lineObj1 = ThisDocument.ModelSpace.AddLine(P1, P2)

lineObj1.LineWeight = zcLnWt050

'lineObj1.Color = zcBlue

ThisDocument.Regen

Dim Px

Dim P3

Dim P4

'Dim P5

'Dim Py

Dim Odleglosc As Double

Dlugosc = Dpp(P1, P2) ' / 2#

Px = P1 'PLD(P1, P2, Dlugosc)

'Py = P2

Dim Nachylenie As Double

Nachylenie = ThisDocument.Utility.AngleFromXAxis(P1, P2)

Dim Pi As Double

Pi = 1.570796

P3 = Px 'ThisDocument.Utility.PolarPoint(Px, Nachylenie - Pi, Dlugosc)

P4 = ThisDocument.Utility.PolarPoint(Px, Nachylenie + Pi, Dlugosc)

'P5 = ThisDocument.Utility.PolarPoint(Py, Nachylenie + Pi, Dlugosc)

Dim lineObj2 As ZwcadLine

Set lineObj2 = ThisDocument.ModelSpace.AddLine(P3, P4)

lineObj2.LineWeight = zcLnWt050

Dim kąt As Double

kąt = ThisDocument.Utility.AngleFromXAxis(P1, P2)

Dim Pi2 As Double

Pi2 = 2 * Atn(1)

Dim A1Arc As ZwcadArc

Set A1Arc = ThisDocument.ModelSpace.AddArc(P3, Dlugosc, kąt, kąt + Pi)

'A1Arc.LineWeight = zcLnWt050

'lineObj2.Color = zcGreen

Dim Kreskowanie As ZwcadHatch

Set hatchobj = ThisDocument.ModelSpace.AddHatch(zcHatchPatternTypePreDefined, "Solid", True)

Dim outerloop As ZwcadLWPolyline

Dim object(0 To 0) As ZwcadEntity

Dim pts(0 To 5) As Double

pts(0) = Px(0): pts(1) = Px(1)

pts(2) = P2(0): pts(3) = P2(1)

pts(4) = P4(0): pts(5) = P4(1)

Set outerloop = ThisDocument.ModelSpace.AddLightWeightPolyline(pts)

outerloop.Closed = True

outerloop.Update

Set object(0) = outerloop

hatchobj.AppendOuterLoop (object)

'hatchobj.PatternScale = 0.5

hatchobj.Update

' kreskuje , ale nie po łuku

ThisDocument.Regen

'rysuje kąt prosty z równych odcinków od P1 do P2 z dołu do góry ,od P1 w lewo drugi odcinek,oraz łuk

End Sub

Wygląda tak

---