4 linie równoległe, makra zwcad

[ Pobierz całość w formacie PDF ]

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 P6

    Dim P7

    Dim P8

    Dim P9

    Dim P10

    Dim P11

    Dim Odleglosc As Double

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

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

    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, 50)

    P5 = ThisDocument.Utility.PolarPoint(P2, Nachylenie + Pi, 50)

    P6 = ThisDocument.Utility.PolarPoint(P2, Nachylenie + Pi, 100)

    P7 = ThisDocument.Utility.PolarPoint(Px, Nachylenie + Pi, 100)

    P8 = ThisDocument.Utility.PolarPoint(P2, Nachylenie + Pi, 150)

    P9 = ThisDocument.Utility.PolarPoint(Px, Nachylenie + Pi, 150)

    P10 = ThisDocument.Utility.PolarPoint(P2, Nachylenie + Pi, 200)

    P11 = ThisDocument.Utility.PolarPoint(Px, Nachylenie + Pi, 200)

    Dim lineObj2 As ZwcadLine

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

    'lineObj2.LineWeight = zcLnWt050

    Dim lineObj3 As ZwcadLine

    'Set lineObj3 = ThisDocument.ModelSpace.AddLine(P2, P5)

    'lineObj3.LineWeight = zcLnWt050

    Dim lineObj4 As ZwcadLine

    Set lineObj4 = ThisDocument.ModelSpace.AddLine(P4, P5)

    lineObj4.LineWeight = zcLnWt050

    Dim lineObj5 As ZwcadLine

    Set lineObj5 = ThisDocument.ModelSpace.AddLine(P6, P7)

    lineObj5.LineWeight = zcLnWt050

    Dim lineObj6 As ZwcadLine

    Set lineObj6 = ThisDocument.ModelSpace.AddLine(P8, P9)

    lineObj6.LineWeight = zcLnWt050

    Dim lineObj7 As ZwcadLine

    Set lineObj7 = ThisDocument.ModelSpace.AddLine(P10, P11)

    lineObj7.LineWeight = zcLnWt050

    'Dim lineObj8 As ZwcadLine

    'Set lineObj8 = ThisDocument.ModelSpace.AddLine(P8, P9)

    'lineObj8.LineWeight = zcLnWt050

    'lineObj2.Color = zcGreen

    ThisDocument.Regen

    'rysuje 4 linie równoległe do P1,P2 oddalone od siebie o 50 jednostek

End Sub

Tak wyglądają