Алексей Аширов (Все сообщения пользователя)

Sub RelocateMap
    
Set Tools = CreateObject("zululib.ZuluTools")
       
'Смена адреса слоев ZuluServer конкретной карты
Tools.Relocate ("d:\test\test.zmp", "zulu://xxx.domen.ru", "zulu://yyy.domen.ru", 0)

'Смена адреса слоев ZuluServer для всех карт в папке
Tools.Relocate ("d:\test\", "zulu://xxx.domen.ru", "zulu://yyy.domen.ru", 4)

'Смена адреса слоев ZuluServer для всех карт в папке и вложенных папках
Tools.Relocate ("d:\test\", "zulu://xxx.domen.ru", "zulu://yyy.domen.ru", 4+8)

'Смена любого фрагмента пути слоев как адресов ZuluServer, так и локальных 
Tools.Relocate ("d:\test\test.zmp", "xxx", "yyy", 2)
    
End Sub

Sub CrossLines

  Set Out = OpenOutputChannel ("")
  Out.Clear

  'Первый слой
  Set L1 = Zulu.ActiveMapDoc.Layers.Item(1)
  'Второй слой
  Set L2 = Zulu.ActiveMapDoc.Layers.Item(2)
  
  Set Geo1 = CreateObject("ZuluLib.ZGeoObject")
  Set Geo2 = CreateObject("ZuluLib.ZGeoObject")
  
  'Объект первого слоя
  Geo1.Init L1.Elements.Item(2609), L1.GetCRS  
  
  'Объект второого слоя
  Geo2.Init L2.Elements.Item(1679), L2.GetCRS  
    
  Set Geom = CreateObject("ZuluLib.ZGeometry")

  'Точки пересечения объектов  
  Set Pts = Geom.CrossGeoObjects(Geo1, Geo2, 0)

  Out.PutLine "count=" + CStr(Pts.Count)  
  
  for i = 1 to Pts.Count     
  
  Out.PutLine "x=" + CStr(Pts.GetX(i)) + " y=" + CStr(Pts.GetY(i))
  
  Next  

End Sub

Sub LayerCrs

  Set Out = OpenOutputChannel ("")

  Out.Clear

  n = Zulu.ActiveMapDoc.Layers.Count

  Out.PutLine CStr(n)

  For i = 1 to n

    Set L = Zulu.ActiveMapDoc.Layers.Item(i)

    Out.PutLine L

    Set p = L.GetCRS
  
    Out.PutLine p.Projection.Name  

  Next

End Sub

Sub JoinPipes

'Активный слой текущей карты
    Set L = Zulu.ActiveMapDoc.Layers.Active

'Имя слоя для копирования
    NewLayerName = Left(L1.Name, InStrRev(L1.Name, ".") - 1)
    NewLayerName = NewLayerName + "_test"

'Копировние в новый слой структуры исходного слоя
    Set Tools = CreateObject("ZuluLib.ZuluTools")
    Tools.LayerCopyEx L1.Name, NewLayerName, "Тест", 4 + 16

'Открываем слой для записи результата 
    Set L_out = CreateObject("ZuluLib.Layer")
    L_out.Open NewLayerName

'Получаем список всех pass_id слоя
    Set Result1 = L1.ExecSQL("SELECT DISTINCT pass_id", 0)

    If  Result1.RetCode = 0 then

        Set ds1 = Result1.DataSet

       'Идем по списку
        ds1.MoveFirst

        Do
            If ds1.Eof = true then exit do

            'Получили из списка очередной pass_id
            pass_id = ds1.FieldValue(0)

            query = "SELECT Sys WHERE pass_id=" + pass_id

            'Получаем список всех Sys с этим pass_id
            Set Result2 = L1.ExecSQL(query, 0)

            If Result2.RetCode = 0 then

                'Создаем объект для накопления мультилинии 
                Set PPL_out = CreateObject("ZuluLib.PolyPolyLine")

                FirstElemID = -1
                FirstElemType = -1
                FirstElemMode = -1

                'Идем по списку Sys
                Set ds2 = Result2.DataSet               
                ds2.MoveFirst
                
                Do While ds2.Eof = false
                   
                    'Получаем элемент для очередного Sys
                    ElemID = CInt(ds2.FieldValue(0))

                    Set El = L1.Elements.Item(ElemID)

                    'Если это первый Sys списка, запоминаем его ID, тип и режим
                    If FirstElemID = -1 Then
                        FirstElemID = ElemID
                        FirstElemType = El.TypeID
                        FirstElemMode = El.ModeId
                    End If
                    
                    'Для общности получаем мультилайн объекта (в частном случае просто полилиния)
                    Set PPL = El.PolyPolyLine

                    For i = 0 To PPL.Count - 1
                      'Добавляем полилинию в накопитель для мультилинии
                      PPL_out.AddPolyline PPL.Item(i)

                    Next

                    ds2.MoveNext
                Loop

                'Записываем мультилинию в новый слой
                If FirstElemID <> -1 Then

                    NewID = L_out.AddPolyPolyLine(PPL_out, nothing, FirstElemType, FirstElemMode)

                    If NewID <> -1 Then

                       'Присваиваем мультилинии ID объекта из исходного слоя
                        L_out.ChangeElemID NewID, FirstElemID, true

                        'Записываем pass_id  в новый слой
                        Set res = L_out.ExecSQL("UPDATE SET pass_id=" + pass_id + " WHERE Sys=" + CStr(FirstElemID))

                    End If

                End If

            End If

            ds1.MoveNext

        loop

    End if

End Sub

Sub HttpClient

Set S = CreateObject("ZuluLib.ZHttpSettings")

S.SetClientType 1

End Sub