代码如下：
Sub RunScript(ByVal pts As List(Of On3dPoint), ByVal srfProject As OnSurface, ByVal crvClosest As OnCurve)
'输入：21*21的点，后面房子的窗台所在平面，后面房子的窗台轮廓线
Dim sunVector As New List(Of On3dVector)
Dim startH As Integer = 8
Dim endH As Integer = 16
Dim startT As Integer = startH * 60
Dim endT As Integer = endH * 60
Dim stepT As Integer = 10
Dim sunDirection As New List(Of On3dVector)
Dim SolarTime As Integer
Dim dblTemp,sunh,sunA As Double
Const pi As Double = 3.1415926
Const Latitude As Double = 39.13
Const SolarLatitude As Double = -23.45
Dim list As New List(Of On3dVector)
Dim GoodPts As New List(Of On3dPoint)
'得到大寒日8点到16点太阳入射的方向的向量 ，时间间隔10分钟
For MinuteID As Integer = startT To endT Step stepT
SolarTime = 15.0 * ((MinuteID - 12 * 60.0) / 60.0)
dblTemp = Sin(Latitude / 180 * pi) * Sin(SolarLatitude / 180 * pi) + Cos(Latitude / 180 * pi) * Cos(SolarLatitude / 180 * pi) * Cos(SolarTime / 180 * pi)
If dblTemp >= -1 And dblTemp <= 1 Then
Sunh = Asin(dblTemp)
If Sunh > 0 Then 'ensure the sun is above the ground
dbltemp = Cos(SolarLatitude / 180 * pi) * Sin(SolarTime / 180 * pi) / Cos(Sunh)
If dblTemp >= -1 And dblTemp <= 1 Then
SunA = Asin(dbltemp)
SunA = SunA * (-1) + 3 * pi / 2
Dim v As New On3dVector(cos(SunA), sin(SunA), tan(Sunh))
sunVector.Add(v)
End If
End If
End If
Next
用do……loop循环移动点
For i As Integer=0 To pts.Count - 1
Dim blnGood As Boolean
Do While blnGood = False
'自定了一个函数isGoodPoint判断改点是否满足日照
blnGood = isGoodPoint(sunVector, pts(i), srfProject, crvClosest)
print(blnGood)
pts(i).y = pts(i).y - 1
Loop
GoodPts.add(pts(i))
Next
A = GoodPts
End Sub
'从调试来看好像程序把所有的移动的命令都算在第一个点上了，以至于第一个点移动了730米，其他的点一个都没动……
#Region "Additional methods and Type declarations"
'自定函数isGoodPoint
Function isGoodPoint(ByRef listVector As list(Of On3dVector), ByRef pt As On3dPoint, ByRef srf As OnSurface, ByRef crv As OnCurve)As Boolean
Dim good As Integer = 0
Dim isgood As Boolean
For j As Integer =0 To listVector.count - 1
Dim pt2 As New On3dPoint(pt.x - listVector(j).x * 1000, pt.y - listVector(j).y * 1000, pt.z - listVector(j).z * 1000)
Dim line As New OnLine(pt, pt2)
Dim t As Double
Dim mm As New ArrayOnX_EVENT
Dim tt As Double = line.IntersectSurface(srf, mm)
Dim ProjectPt As New On3dPoint(line.PointAt(tt))
crv.GetClosestPoint(projectPt, t)
Dim ClosePt As New On3dPoint (crv.PointAt(t))
If projectPt.y < closePt.y Then
good = good + 1
End If
Next
If good / 6 > 2 Then
isgood = True
Else
isgood = False
End If
Return isgood
End Function
