https://wiki.sdms.si/index.php?action=history&feed=atom&title=Uporabne_rutine 2026-05-06T14:11:23Z Zgodovina navedene strani SDMS MediaWiki 1.32.0 https://wiki.sdms.si/index.php?title=Uporabne_rutine&diff=4774&oldid=prev 2011-06-01T11:27:01Z

<p>Nova stran z vsebino: == Povezave do otokov == * Verzija: 1.0 * Datum: 1.6.2011 * Avtor: Aleš Trtnik Ta rutina najde v poligonski plasti vse povezave do otokov. Najdene povezave zapiše v drugo ...</p> <p><b>Nova stran</b></p><div><br /> == Povezave do otokov ==<br /> <br /> * Verzija: 1.0<br /> * Datum: 1.6.2011<br /> * Avtor: Aleš Trtnik<br /> <br /> Ta rutina najde v poligonski plasti vse povezave do otokov. Najdene povezave zapiše v drugo plast.<br /> <br /> &lt;source&gt;Sub PovezaveDoOtokov<br /> Dim I, J, K As Long, L, L1 As TLayer, PA, PB As TPointArray, Check, Check1 As Boolean<br /> L = [Poligonska plast] //Vhodni podatki<br /> L1 = [Linijska plast] //Izhodni podatki (Vsebina se izbriše)<br /> L1.DeleteAllData (True)<br /> L1.BeginMultipleUpdate<br /> For I = 0 To L.AllRecords.Count - 1<br /> HintNum2 (&quot;A&quot;, I, L.AllRecords.Count)<br /> PB = L.AllRecords.Items (I).PointArray<br /> PB.DeletePoint (0)<br /> PB.Sort<br /> Check = False<br /> For J = 0 To PB.Count - 2<br /> If (PB.Y(J) = PB.Y(J+1)) And (PB.X(J) = PB.X(J+1)) Then<br /> Check = True<br /> Break<br /> EndIf<br /> Next<br /> If Check Then<br /> For J = PB.Count - 2 To 0 Step - 1<br /> If Not ((PB.Y(J) = PB.Y(J+1)) And (PB.X(J) = PB.X(J+1))) Then<br /> PB.DeletePoint (J+1)<br /> If J = 0 Then PB.DeletePoint (0) EndIf<br /> EndIf<br /> Next<br /> PA = L.AllRecords.Items (I).PointArray<br /> For J = 0 To PA.Count - 3<br /> If (PB.Find (pa.Y(J), pa.X(J)) &gt;= 0) And<br /> (PB.Find (pa.Y(J+1), pa.X(J+1)) &gt;= 0) Then<br /> HintNum4 (&quot;B&quot;, I, L.AllRecords.Count, J, PB.Count)<br /> For K = J + 2 To PA.Count - 1<br /> If (pa.Y(J) = pa.Y(K)) And (pa.X(J) = pa.X(K)) Then<br /> Check1 = ((pa.Y(J+1) = pa.Y(K-1)) And (pa.X(J+1) = pa.X(K-1)))<br /> If Not Check1 And (K &lt; PA.Count - 1)Then<br /> Check1 = ((pa.Y(J+1) = pa.Y(K+1)) And (pa.X(J+1) = pa.X(K+1)))<br /> EndIf<br /> If Check1 Then<br /> L1.EditRecord.Append<br /> L1.EditRecord.SetPolyline<br /> L1.EditRecord.AddPoint (pa.Y(J), pa.X(J))<br /> L1.EditRecord.AddPoint (pa.Y(J+1), pa.X(J+1))<br /> L1.EditRecord.AutoCentroid<br /> L1.EditRecord.Update<br /> Check = True<br /> EndIf<br /> EndIf<br /> Next<br /> EndIf<br /> Next<br /> Destroy (PA)<br /> EndIf<br /> Next<br /> Destroy (PB)<br /> L1.EndMultipleUpdate<br /> L1.Optimize<br /> EndSub&lt;/source&gt;</div>

Aleš Trtnik