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 Przyklad()

Dim P1 As Variant

Dim P2 As Variant

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

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

Dim lineObj As ZwcadLine

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

Dim Odleglosc As Double ' Odległość dzieląca dwa sąsiednie punkty

Dim IlePunktow As Integer

IlePunktow = 2 ' Bo 2 na końcach + 2 w środku

Odleglosc = Dpp(P1, P2) / (IlePunktow + 1)

Dim PxE As ZwcadPointEntity

Set PxE = ThisDocument.ModelSpace.AddPointEntity(P1)

PxE.Color = zcBlue

Set PxE = ThisDocument.ModelSpace.AddPointEntity(P2)

PxE.Color = zcRed

Set PxE = ThisDocument.ModelSpace.AddPointEntity(PLD(P1, P2, Odleglosc))

PxE.Color = zcGreen

Set PxE = ThisDocument.ModelSpace.AddPointEntity(PLD(P1, P2, 2 * Odleglosc))

PxE.Color = zcYellow

ThisDocument.Regen

'rysuje odcinek z punktami :początek niebieski , koniec czerwony ;w środku zielony i żółty

End Sub

---