Altium 分形天线设计

Altium 分形天线设计

 

 

 

程序运行界面

 

 

Cantor三分集

 

 

Koch雪花

 

 

Sierpinski垫片

 

 

 

源代码：

Iter_Num = 4     'diedai

    PI = 3.1415926

 

 

    Call Client.StartServer("PCB")

    PcbFileName = "PCB1.PcbDoc"

    Set Document  = Client.OpenDocument("PCB", PcbFileName)

 

    If Not (Document Is Nothing) Then

        'Add this schematic sheet in the newly created PCB project in DXP.

        Set Workspace = GetWorkspace

        If Not (Workspace Is Nothing) Then

            Workspace.DM_FocusedProject.DM_AddSourceDocument(Document.FileName)

        End If

        Client.ShowDocument(Document)

    End If

 

 

'Draw Line Function

Sub Paint_Line(x1,y1,x2,y2)

    Dim Board

    Dim Track

    Set Board = PCBServer.GetCurrentPCBBoard

    Track          = PCBServer.PCBObjectFactory(eTrackObject,eNoDimension,eCreate_Default)

    Track.X1       = MilsToRealCoord(CLng(x1)+Board.GetState_XOrigin/10000)

    Track.Y1       = MilsToRealCoord(CLng(y1)+Board.GetState_XOrigin/10000)

    Track.X2       = MilsToRealCoord(CLng(x2)+Board.GetState_XOrigin/10000)

    Track.Y2       = MilsToRealCoord(CLng(y2)+Board.GetState_XOrigin/10000)

    Track.Layer    = eTopLayer

    Track.Width    = MilsToCoord (10)

    Board.AddPCBObject(Track)

    Board.LayerIsDisplayed(ALayer) = True

End Sub

 

'Draw rectangle Function

Sub Paint_Rectangle(x1,y1,x2,y2)

    call Paint_Line(x1,y1,x2,y1)

    call Paint_Line(x1,y1,x1,y2)

    call Paint_Line(x1,y2,x2,y2)

    call Paint_Line(x2,y1,x2,y2)

End Sub

 

Sub Action_Redraw()

    Call Client.SendMessage("PCB:Zoom","Action=Redraw", 255, Client.CurrentView)

    Call Client.SendMessage("PCB:Zoom","Action=All", 255, Client.CurrentView)

End Sub

 

 

'SetState_Origin

Sub Set_Origin()

    Set Board = PCBServer.GetCurrentPCBBoard

    Board.SetState_YOrigin(40000000)

    Board.SetState_XOrigin(40000000)

End Sub

 

Sub Board_Shape()

    Call AddStringParameter("Scope", "All")

    RunProcess("PCB:Select")

 

    Call AddStringParameter("Mode", "BOARDOUTLINE_FROM_SEL_PRIMS")

    RunProcess("PCB:PlaceBoardOutline")

 

    Call AddStringParameter("Size", "2.500MM")

    RunProcess("PCB:SnapGrid")

 

    Call AddStringParameter("MeasurementUnit", "Toggle")

    RunProcess("PCB:DocumentPreferences")

End Sub

 

 

Sub CantorClick(Sender)

    Board_chang = 100/0.0254

    Board_kuan = 100/0.0254

    Iter_Num = 5

    call Set_Origin()

    call Paint_Rectangle(0,0,Board_chang,Board_kuan)

    Call Board_Shape()

    Call Cantor_digui(0,0,Board_chang,0,Iter_Num)

    Action_Redraw()

    Close

End Sub

 

Sub  Cantor_digui(ax,ay,bx,by,m)

    If m=1 Then

        Call Paint_Line(ax,ay,bx,by)

    Else

        Call Paint_Line(ax,ay,bx,by)

        cx=ax+(bx-ax)/3

        cy=ay+100

        dx=bx-(bx-ax)/3

        dy=by+100

 

        ay=ay+100

        by=by+100

 

        Call Cantor_digui(ax,ay,cx,cy,m-1)

        Call Cantor_digui(dx,dy,bx,by,m-1)

    End If

    m=m-1

End Sub

 

 

Sub KochClick(Sender)

    Board_chang = 100/0.0254

    Board_kuan  = 100/0.0254

    m = Board_chang

 

   
Iter_Num = 11

 

    call Set_Origin()

    call Paint_Rectangle(0,0,Board_chang,Board_kuan)

    Call Board_Shape()

    Action_Redraw()

    Call Fractal(m/2-sqr(3)/2*m/2,m/2+m/4,m/2+sqr(3)/2*m/2,m/2+m/4,Iter_Num)

    Call Fractal(m/2,m/2-m/2,m/2-sqr(3)/2*m/2,m/2+m/4,Iter_Num)

    Call Fractal(m/2+sqr(3)/2*m/2,m/2+m/4,m/2,m/2-m/2,Iter_Num)

 

    Action_Redraw()

    Close

End Sub

 

 

Sub Fractal(ax,ay,bx,by,Iter_Num)

    if Iter_Num = 1 Then

        Call Paint_Line(ax,ay,bx,by)

    else

        cx=ax+(bx-ax)/3

        cy=ay+(by-ay)/3

        ex=bx-(bx-ax)/3

        ey=by-(by-ay)/3

 

        Call Fractal(ax,ay,cx,cy,Iter_Num-1)

        Call Fractal(ex,ey,bx,by,Iter_Num-1)

 

        l=sqr((ex-cx)*(ex-cx)+(ey-cy)*(ey-cy))

        alfa=Atn((ey-cy)/(ex-cx))

 

        if ((alfa>=0 And (ex-cx)<0) Or (alfa<0 And (ex-cx)<0)) Then

            alfa=alfa+PI

        End if

 

        dx=cx+cos(alfa+PI/3)*l

        dy=cy+sin(alfa+PI/3)*l

 

        Call Fractal(cx,cy,dx,dy,Iter_Num-1)

        Call Fractal(dx,dy,ex,ey,Iter_Num-1)

    End If

End Sub

 

 

Sub ArboresentClick(Sender)

    prate=1.5

    theta=atn(sqr(4/prate/prate-1))

    t=PI-4*theta

    alfa=55*PI/180

    leval=1

    x=500

    y=500

    size1=3000

    Call DrawArboresent(x,y,size1,prate,alfa,thata,t,lexel)

End Sub

 

Sub DrawArboresent(x,y,size1,prate,alfa,thata,t,lexel)

    L_X=200

    L_Y=300

    l=size1/prate

    xe=x

    ye=y

    xa=x+size1*cos(alfa)

    ya=y+size1*sin(alfa)

    xb=x+l*cos(alfa-theta)

    yb=y+l*sin(alfa-theta)

    xc=x+l*cos(alfa-theta-t)

    yc=x+l*sin(alfa-theta-t)

    xd=x+size1*cos(alfa-theta*2-t)

    yd=x+size1*sin(alfa-theta*2-t)

 

    if level<=1 Then

        Call Paint_Line(L_X-xa/15,L_Y-ya/15,L_X-xe/15,L_Y-ye/15)

        Call Paint_Line(L_X-xe/15,L_Y-ye/15,L_X-xd/15,L_Y-yd/15)

        Call Paint_Line(L_X-xd/15,L_Y-yd/15,L_X-xc/15,L_Y-yc/15)

        Call Paint_Line(L_X-xc/15,L_Y-yc/15,L_X-xe/15,L_Y-ye/15)

        Call Paint_Line(L_X-xe/15,L_Y-ye/15,L_X-xb/15,L_Y-yb/15)

        Call Paint_Line(L_X-xb/15,L_Y-yb/15,L_X-xa/15,L_Y-ya/15)

    End if

 

    Call DrawArboresent(xb,yb,l,prate,alfa-theta+pi,thata,t,lexel-1)

    Call DrawArboresent(xc,yc,l,prate,alfa-theta+pi,thata,t,lexel-1)

End Sub

 

 

Sub LevyClick(Sender)

    m = (100/0.0254)

    call Set_Origin()

    call Paint_Rectangle(0,0,m,m)

    Call Board_Shape()

    Call drawC(0,0,10000,0)

 

    Action_Redraw()

    Close()

End Sub

 

Sub drawC(x1,y1,x2,y2)

    if (x2-x1)<5 Then

        Call Paint_Line(x1,y1,x2,y2)

    else

        Call Paint_Line(x1,y1,x2,y2)

 

        x3=(x1+y1+x2-y2)/2

        y3=(x2+y2+y1-x1)/2

 

        Call Paint_Line(x1,y1,x3,y3)

        Call Paint_Line(x3,y3,x2,y2)

 

        Call drawC(x1,y1,x3,y3)

        Call drawC(x3,y3,x2,y2)

    End if

End Sub

 

 

 

Sub SierpinskiClick(Sender)

    m = (100/0.0254)

    Iter_Num = 7

    call Set_Origin

    call Paint_Rectangle(0,0,m,m)

    Call Board_Shape()

    Action_Redraw()

    Call Sier(0,0,m,m,Iter_Num)

    Action_Redraw()

    Close()

End Sub

 

 

kkk=1

 

Sub Sier(x1,y1,x2,y2,k)

    L=x2-x1

    W=y2-y1

 

    Set Board = PCBServer.GetCurrentPCBBoard

    Region = PCBServer.PCBObjectFactory(eRegionObject, eNoDimension,eCreate_Default)

    Contour = Region.MainContour.Replicate

    Region.Layer = eTopLayer

    Contour.Count = 4

 

    if k=1 Then

        Contour.X(1) = MilsToCoord(x1+L/3)

        Contour.Y(1) = MilsToCoord(y1+W/3)

        Contour.X(2) = MilsToCoord(x2-L/3)

        Contour.Y(2) = MilsToCoord(y1+W/3)

        Contour.X(3) = MilsToCoord(x2-L/3)

        Contour.Y(3) = MilsToCoord(y2-W/3)

        Contour.X(4) = MilsToCoord(x1+L/3)

        Contour.Y(4) = MilsToCoord(y2-W/3)

 

        Call Contour.Translate(MilsToCoord(4000), MilsToCoord(4000))

        Region.SetOutlineContour(Contour)

        Region.Kind = 1

        Board.AddPCBObject(Region)

    else

        Contour.X(1) = MilsToCoord(x1+L/3)

        Contour.Y(1) = MilsToCoord(y1+W/3)

        Contour.X(2) = MilsToCoord(x2-L/3)

        Contour.Y(2) = MilsToCoord(y1+W/3)

        Contour.X(3) = MilsToCoord(x2-L/3)

        Contour.Y(3) = MilsToCoord(y2-W/3)

        Contour.X(4) = MilsToCoord(x1+L/3)

        Contour.Y(4) = MilsToCoord(y2-W/3)

 

        Call Contour.Translate(MilsToCoord(4000), MilsToCoord(4000))

        Region.SetOutlineContour(Contour)

        Region.Kind = 1

        Board.AddPCBObject(Region)

 

        Call Sier(x1,y1,x1+L/3,y1+W/3,k-1)

        Call Sier(x1+L/3,y1,x2-L/3,y1+W/3,k-1)

        Call Sier(x2-L/3,y1,x2,y1+W/3,k-1)

 

        Call Sier(x1,y1+W/3,x1+L/3,y2-W/3,k-1)

        Call Sier(x2-L/3,y1+W/3,x2,y2-W/3,k-1)

 

        Call Sier(x1,y2-W/3,x1+L/3,y2,k-1)

        Call Sier(x1+L/3,y2-W/3,x2-L/3,y2,k-1)

        Call Sier(x2-L/3,y2-W/3,x2,y2,k-1)

    End if

    if kkk=1000 Then

        Call Client.SendMessage("PCB:Zoom","Action=Redraw" , 255, Client.CurrentView)

        kkk=1

    End if

    kkk=kkk+1

End Sub

 

转载于:https://www.cnblogs.com/xiongshuang/p/8784615.html