Аналитика

Цифровая фотограмметрия, картография и землеустройство
Текущее время: 28 мар 2024 22:24

Часовой пояс: UTC + 2 часа




Начать новую тему Ответить на тему  [ Сообщений: 211 ]  На страницу Пред.  1 ... 5, 6, 7, 8, 9, 10, 11 ... 15  След.
Автор Сообщение
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 24 апр 2016 06:36 
Специалист
Специалист
Аватара пользователя

Зарегистрирован:
09 авг 2014 18:30
Сообщения: 15
Откуда: Шепетівка
Доброго ВАМ дня! Скажіть чи поділіться будь ласка скриптом (якщо не важко), який би підписував координату Х та У кожної поворотної точки земельної ділянки. Дякую.


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 24 апр 2016 14:14 
Гуру
Гуру

Зарегистрирован:
05 апр 2012 10:20
Сообщения: 797
Откуда: Львівська область
Можна так:
;вкажіть id шару, в якому створювати точки
$id=id70001
$MapCount=@MapCount
@if $MapCount=0 then @Break
$N=@Map.SelCount
@If $N<1 @Break Виділіть об'єкт для створення підписів
@Map.AddNodes $id 1
@Map.Selected.CreateCaptions -4 1 2 1 1 2 5
@Map.Selected.CreateCaptions -3 1 2 1 1 2 2

_________________
додатково про скрипти Digitals на www.digitals.at.ua


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 24 апр 2016 19:37 
Специалист
Специалист
Аватара пользователя

Зарегистрирован:
09 авг 2014 18:30
Сообщения: 15
Откуда: Шепетівка
Дякую.Дякую.Дякую.Дякую.Дякую.Дякую.Дякую.Дякую.Дякую. :D


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 15 ноя 2016 18:52 
Участник
Участник

Зарегистрирован:
04 фев 2011 15:39
Сообщения: 9
Откуда: м.Хмельницький
[quote="Dmitry_Zolotar"]Извлечение в In4 всех участков в карте

Скрипт извлекает в In4 все участки и записывает в рабочую папку(Сервис-Настройки-Главная-Рабочая папка по умолчанию). Удобен при большом кол-ве участков в карте тем что, в отличии от команды "Извлечь в ин4...", закрывает за собой окна и следит за дубляжем имен файлов.


А можливо дописати скріпт так, щоб викачуємий in4 файл і присвоював кадастровий номер земельної ділянки у форматі, наприклад - 6825088400:05:003:1208, але без двокрапки???


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 15 ноя 2016 20:55 
Участник
Участник

Зарегистрирован:
04 фев 2011 15:39
Сообщения: 9
Откуда: м.Хмельницький
А можливо все так само, тільни ім'я файла щоб витягувало з:

=Parent[23]:Parent[24]:Parent[25]:CUT(4,4,P[34]) КН_Кадастровий номер ЗД

і зберігало у вигляді кадастрового номера без двокрапки, дуже потрібно!!!
Щиро вдячний!


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 15 ноя 2016 20:59 
Участник
Участник

Зарегистрирован:
04 фев 2011 15:39
Сообщения: 9
Откуда: м.Хмельницький
[quote="Dmitry_Zolotar"]Извлечение в In4 всех участков в карте

$Path=d:\temp
$FE=@FolderExists $Path
@if $FE<>1 then @Break Путь "$Path" не существует
$SL=@Map.Selected.List
@Text[1].Text $SL
$SC=@Text[1].Count
@if $SC<1 then @Break Пометьте Іn4-участок(ки)
$SourceMap=@ActivateMap
@Map.DeselectAll
$I=0
%Loop
$I=$I+1
$SO=@Text[1].Line[$I]
$LID=@Map.Object[$SO].LayerID
@if $LID<>20000 then @Goto %Next
@Map.SelectObject $SO
$CadNumber=@Map.Object[$SO].CalculateFormula PARENT[DS](10000)PARENT[SD](10000)P[SC]
$FN=@Map.Object[$SO].Parameter[CM]
@if $FN= then $FN=$CadNumber
@if $FN= then @Goto %Next
Файл | Извлечь участок в In4
@Map.SaveToFile $Path\$FN.in4
@CloseMap
@ActivateMap $SourceMap
@Map.DeselectAll
%Next
@if $I<$SC then @Goto %Loop


:!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!: :!:

PS: Якщо можливо зробіть будь ласка схожий скріпт під *.XML, бо я в програмуванні повний - 0!
Щиро вдячний за допомогу! :)


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 16 ноя 2016 22:49 
Гуру
Гуру

Зарегистрирован:
05 апр 2012 10:20
Сообщения: 797
Откуда: Львівська область
А у вас що карта із масивом вже готових ХМЛ? Чи ви хочете, щоб зразу конвертувало в ХМЛ?

_________________
додатково про скрипти Digitals на www.digitals.at.ua


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 17 ноя 2016 21:55 
Участник
Участник

Зарегистрирован:
04 фев 2011 15:39
Сообщения: 9
Откуда: м.Хмельницький
Так у мене карта із масивом вже готових ХМЛ, а тепер потрібно витягнути їх по окремості і щоб назва файла містила кадастровий номер земельної ділянки :arrow: *(19-и значний).xml :arrow: і бажано в одну папку на локальному диску! Ооо!


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 17 ноя 2016 22:08 
Гуру
Гуру

Зарегистрирован:
05 апр 2012 10:20
Сообщения: 797
Откуда: Львівська область
Проблема в тому, що в дігіталс нема функції - витягнути в ХМЛ. Через це складно суміжники сформувати.

_________________
додатково про скрипти Digitals на www.digitals.at.ua


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 18 ноя 2016 14:35 
Участник
Участник

Зарегистрирован:
04 фев 2011 15:39
Сообщения: 9
Откуда: м.Хмельницький
fendak писал(а):
Проблема в тому, що в дігіталс нема функції - витягнути в ХМЛ. Через це складно суміжники сформувати.


Можливо є резон з Олійником переговорити, щоб добавили в дігіталс функцію - витягнути в ХМЛ!!!???


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 22 ноя 2016 14:32 
Гуру
Гуру

Зарегистрирован:
06 дек 2011 13:07
Сообщения: 200
Откуда: Дубно
fendak писал(а):
Скрипт, який формує Список межових знаків, переданих на зберігання.
Коротко про суть роботи. Формується карта з DMT шаблону. Послідовно запитує виділити закріплені межові знаки на ділянці і будівлю чи ЛЕП, до якої знак прив'язаний промірами. Потім результат промірів і інше заносяться в текстову табличку.
Тут можна переглянути відео - http://www.geosystema.net/forum/viewtopic.php?f=1&t=19487&p=35688#35688

Код:
@Map.DeselectAll
@Map.SelectLayer ID20000
Документи | Опис меж

.....

чому після привязки усіх чотирьох точок нічого далі не відбувається? усе зупиняється і залишається початкова ділянка тільки з привязками точок...?


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 29 ноя 2016 00:58 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
iventy писал(а):
Так у мене карта із масивом вже готових ХМЛ, а тепер потрібно витягнути їх по окремості і щоб назва файла містила кадастровий номер земельної ділянки :arrow: *(19-и значний).xml :arrow: і бажано в одну папку на локальному диску! Ооо!

Колись писав щось подiбне для товариша з Закарпаття, може чимось Вам поможе
Код:
;Для ЦIМБОРА (формування окремих ХМЛ з одного масиву 09.04.2015)
$Count=@MapCount
;вихiд, коли не вiдкрито жодної карти
@if $Count=0 @Break
$Source=@ActivateMap
$FPath=@Map.ClearFilename
$FPath=@ExtractFilePath $FPath
;перевiрка, чи немає лишнiх об'єктiв на шарах in4
@Map.DeselectAll
@Map.SelectLayer ID10000 ID20000 ID30000 ID50000
$ParcCnt=@Map.SelCount
@if $ParcCnt=0 then @Goto %PRStart
$DLG=@Dialog.Confirm На шарах IN4 є об'єкти. Витерти їх для коректного виконання програми?
@if $DLG=0 then @Break
@Map.Selected.Delete
%PRStart:
;витираємо шари IN4
$Lay=@Map.Layers.FindByID ID10000
@if $Lay<>0 then @Map.Layers.Delete $Lay
$Lay=@Map.Layers.FindByID ID20000
@if $Lay<>0 then @Map.Layers.Delete $Lay
$Lay=@Map.Layers.FindByID ID30000
@if $Lay<>0 then @Map.Layers.Delete $Lay
$Lay=@Map.Layers.FindByID ID50000
@if $Lay<>0 then @Map.Layers.Delete $Lay
; шари видалено
@Map.DeselectAll
; берем загальнi данi xml
@Map.SelectLayer ID70003
$DS=@Map.NextSelected
$DS=@Map.GetObjectParamBuf $DS
@Map.DeselectAll
;працюєм далi
$Count=@Map.Count
$CurrentObject=0
%Loop
;копiюєм в буфер шар 'реквiзити файлу'
@Map.SelectLayer ID70000
@Map.Selected.Copy
@Map.DeselectAll
$CurrentObject=$CurrentObject+1
$LID=@Map.Object[$CurrentObject].LayerID
@if $LID<>70005 then @Goto %Continue
@Map.SelectObject $CurrentObject
@ExecuteMenu FileExtractToIn4
$Target=@ActivateMap
;@Dialog.Message before PASTE
;вставляєм з буферу шар 'реквiзити файлу'
@Map.Paste
;@Dialog.Message after PASTE
; записуємо данi 'DS'
@Map.DeselectAll
@Map.SelectLayer ID70003
$ParcCnt=@Map.SelCount
@if $ParcCnt=0 then @Goto %CRLayer
;@Dialog.Message OLD
%SetParam:
$DSnew=@Map.NextSelected
@Map.SetObjectParamBuf $DSnew|$DS
@Map.DeselectAll
;@Dialog.Message Set parameter to obj: $DSnew
@goto %NextCHK
%CRLayer:
; наступну стрiчку забрати для подальшого вiдлагоджування
; @goto %NextCHK
$Bnum=$CurrentObject
;@Dialog.Message OK $Bnum
; пошук елементу "Дiлянка"
$CountXMLmap=@Map.Count
%FindBND
;@Dialog.Message $CountXMLmap
$ObjID=@Map.Object[$CountXMLmap].ID
@if $CurrentObject<>$ObjID then @goto %ExitCycle
;знайдено об'єкт з нашою дiлянкою в новоствореному файлi
$Bnum=@Map.Object[$CountXMLmap].Index
;@Dialog.Message IDX=$Bnum
%ExitCycle
$CountXMLmap=$CountXMLmap-1
@if $CountXMLmap>0 then @goto %FindBND
@Map.DeselectAll
;копiюємо дiлянку в шар 'кадастрова зона'
@Map.Object[$Bnum].Select
@Map.Selected.Copy
@Map.Paste
@Map.ChangeSelectedLayer ID70003
;@Dialog.Message End $Bnum
;
;@Dialog.Message NEW OK
;створюємо новий шар на основi дiлянки
@goto %SetParam
%NextCHK
; перевiрки:
; 1. якщо є шар in4-сумiжник перекидаємо його в xml-сумiжник
@Map.SelectLayer ID50000
@if @Map.SelCount=0 then @Goto %XMLcreate
@Map.ChangeSelectedLayer ID70010
%XMLcreate
; 2. перевiрка на к-сть дiлянок в малюнку (якщо > 1 тодi
;    перекидаєм їх на шар з сумiжниками)
@Map.DeselectAll
@Map.SelectLayer ID70005
$ParcCnt=@Map.SelCount
;    - якщо одна тодi далi
@if $ParcCnt=1 then @Goto %Single
;    - якщо > одної тодi
$XMLobject=0
;@Dialog.Message START
%Loop2
$XMLobject=@Map.NextSelected $XMLobject
$IDX=@Map.Object[$XMLobject].ID
;@Dialog.Message $ParcCnt $XMLobject $IDX $CurrentObject
@if $IDX<>$CurrentObject then @Goto %ReplLayer
; викидаємо саму дiлянку з списку помiчених
;@Dialog.Message Замiна $IDX
@Map.DeselectObject $XMLobject
;@Dialog.Message del
%NextStep
$ParcCnt=$ParcCnt-1
@if $ParcCnt>0 then goto %Loop2
@Goto %Single
%ReplLayer:
@Map.DeselectAll
@Map.SelectObject $XMLobject
; прайюємо з параметрами XML Дiлянка-Сумiжник
; формуємо данi про землекористувача
$A=@Map.Object[$XMLobject].Parameter[63]
$Sstr=@Calc Pos("<Authentication>","$A")
$Estr=@Calc Pos("</Authentication>","$A")
$A=@Calc Copy("$A",$Sstr+16,$Estr-$Sstr-16)
$A=@DequoteText $A
$A=<Proprietor>$A</Proprietor>
; перекидаєм помiченi на шар сумiжникiв
@Map.Selected.ChangeLayer ID70010
@Map.Selected.SetParameter 106 $A
@Goto %XMLcreate
;
%Single:
@Map.DeselectAll
;$FName=@Map.ClearFilename
$FName=@Map.XMLCadastralNumber
$FName=$FPath$FName
;@Dialog.Message $FName
$Suffix=0
%NextSuffix
$Suffix=$Suffix+1
$FFN=$FName
@if $Suffix<>1 then $FFN=$FFN($Suffix)
$FFN=$FFN.xml
$FE=@FileExists $FFN
@if $FE<>0 then @Goto %NextSuffix
%SaveIn4
@Map.SaveToFile $FFN
@CloseMap $Target
%Continue
@ActivateMap $Source
@Map.DeselectAll
@if $CurrentObject<$Count then @Goto %Loop
;

_________________
Більшість хороших програмістів виконують свою роботу не тому, що очікують оплати або визнання, а тому, що отримують задоволення від програмування.


Последний раз редактировалось Руслан Пархуць 08 июн 2019 15:27, всего редактировалось 1 раз.

Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 09 дек 2016 02:41 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
Ryvol писал(а):
...буде цікаво зробити варіант вводу довжин та внутрішніх кутів (Полярним методом) в самому Діджіталс без додаткових заморочок із модулем "Геодезiя (Geodesy.exe)".
http://www.geosystema.net/forum/viewtopic.php?f=1&p=38368#38368

Код:
$Count=@MapCount
@if $Count=0 @Break
@Map.DeselectAll
$Dialog=@Dialog.WaitBox Виберiть початкову лiнiю для роботи
@If $Dialog=0 @Break
$ObjSel=@Map.SelCount
@if $ObjSel=0 @Break
@if $ObjSel > 1 then goto %ErrCount
$NObj=@Map.NextSelected
$Cnt=@Map.Object[$NObj].Count
@if $Cnt<2 then goto %ErrLine
%Cycle
$CntP=$Cnt-1   
$PntPrev=@Map.Object[$NObj].Point[$CntP]
$PntCur=@Map.Object[$NObj].Point[$Cnt]
$LnAng=@Map.Object[$NObj].LineAngle[$CntP]
$LnAng=@Calc Replace("$LnAng",",",".")
$InputP=@Dialog.Ask Введiть довжину та кут (25.00 90 00 00)
$InputP=@Calc Replace("$InputP",".",",")
$InputP=@DequoteText $InputP
$Dist=@StringPart 1 $InputP
$Dist=@Calc Replace("$Dist",",",".")
$Dist=@DequoteText $Dist
$Ang1=@StringPart 2 $InputP
$Ang2=@StringPart 3 $InputP
$Ang3=@StringPart 4 $InputP
@If $Ang1= then $Ang1=0
@If $Ang2= then $Ang2=0
@If $Ang3= then $Ang3=0
@if $Ang1 < 0 then goto %LeftCrd
$Angle=(($Ang3/60+$Ang2)/60+$Ang1)*-1
@Goto %Next
%LeftCrd
$Angle=(($Ang3/60+$Ang2)/60-$Ang1)
%Next
$Angle=$LnAng-180+$Angle
$Rad=$Angle*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$PntX=@StringPart 1 $PntCur
$PntY=@StringPart 2 $PntCur
$PntX=@Calc Replace("$PntX",",",".")
$PntY=@Calc Replace("$PntY",",",".")
$DX=$PntX+$ACos*$Dist
$DX=@Calc Replace("$DX",".",",")
$DX=@DequoteText $DX
$ASin=@Calc Sin($Rad)
$DY=$PntY+$ASin*$Dist
$DY=@Calc Replace("$DY",".",",")
$DY=@DequoteText $DY
@Map.Object[$NObj].AddPoint $DX $DY
@Map.Selected.Refresh
@Window.ShowSelected
@Window.Position $DX $DY
$Cnt=@Map.Object[$NObj].Count
@Goto %Cycle
@goto %End
%ErrLine
@dialog.message Виберiть лiнiйний елемент для роботи
@goto %End
%ErrCount
@dialog.message Виберiть лише один лiнiйний елемент для роботи
%End

_________________
Більшість хороших програмістів виконують свою роботу не тому, що очікують оплати або визнання, а тому, що отримують задоволення від програмування.


Последний раз редактировалось Руслан Пархуць 09 дек 2016 18:03, всего редактировалось 1 раз.

Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 09 дек 2016 16:47 
Гуру
Гуру

Зарегистрирован:
02 апр 2013 15:28
Сообщения: 177
А би ще по цьому і звіт зформувати.


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Библиотека полезных скриптов
СообщениеДобавлено: 09 дек 2016 22:35 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
klaid писал(а):
А би ще по цьому і звіт зформувати.

звiт в Geodesy.exe :)

aero36 писал(а):
возможно ли в digitals построить биссектрису угла штатными средствами? или как то реализуется скриптом?
http://www.geosystema.net/forum/viewtopic.php?f=1&t=19659#38387

10.12.2016 дописав роботу з замкненими контурами
Код:
; www.geosystema.net/forum/viewtopic.php?f=1&t=2539&start=120#38388
; 09.12.2016
$Count=@MapCount
@if $Count=0 @Break
$Sel=@Map.SelCount
@if $Sel=0 then @break Виберiть елементи
$Obj=0
;Parameters
$Dist=100
$Param=4
%Cycle
$Obj=@Map.NextSelected $Obj
$PntCnt=@Map.Object[$Obj].Count
@if $PntCnt<3 then goto %SkipElem
; якщо контур замкнений
$Closed=@Map.Object[$Obj].Closed
@if $Closed=1 then @goto %CloseElem
$PntCnt=$PntCnt-1
%DrawBS
@if $PntCnt=1 then @goto %SkipElem
$PrvCnt=$PntCnt-1
$LnAng1=@Map.Object[$Obj].LineAngle[$PntCnt]
$LnAng2=@Map.Object[$Obj].LineAngle[$PrvCnt]
@goto %Next
%CloseElem
$EndPnt=@Map.Object[$Obj].Count
$EndPnt=$EndPnt-1
$LnAng1=@Map.Object[$Obj].LineAngle[$EndPnt]
$LnAng2=@Map.Object[$Obj].LineAngle[1]
%Next
$PntCur=@Map.Object[$Obj].Point[$PntCnt]
$LnAng1=@Calc Replace("$LnAng1",",",".")
$LnAng1=@DequoteText $LnAng1
$LnAng2=@Calc Replace("$LnAng2",",",".")
$LnAng2=@DequoteText $LnAng2
$LnAng2=$LnAng2+180
@if $LnAng2>360 then $LnAng2=$LnAng2-360
$Angle=$LnAng1-180+($LnAng2-$LnAng1)/2
@if $LnAng2<$LnAng1 then $Angle=$Angle+180
$Rad=$Angle*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$PntX=@StringPart 1 $PntCur
$PntY=@StringPart 2 $PntCur
$PntX=@Calc Replace("$PntX",",",".")
$PntY=@Calc Replace("$PntY",",",".")
$PntX=@DequoteText $PntX
$PntY=@DequoteText $PntY
$DX=$PntX+$ACos*$Dist
$DX=@Calc Replace("$DX",".",",")
$DX=@DequoteText $DX
$ASin=@Calc Sin($Rad)
$DY=$PntY+$ASin*$Dist
$DY=@Calc Replace("$DY",".",",")
$DY=@DequoteText $DY
$PntX=@Calc Replace("$PntX",".",",")
$PntY=@Calc Replace("$PntY",".",",")
$PntX=@DequoteText $PntX
$PntY=@DequoteText $PntY
$Layer=@Map.Object[$Obj].Layer
$N=@Map.AddObject 0|1|$Layer|2|0 $PntX $PntY 0|0 $DX $DY 0|1|$Layer|1|$Param $Angle
$PntCnt=$PntCnt-1
@if $PntCnt>0 then @goto %DrawBS
%SkipElem
$Sel=$Sel-1
@if $Sel>0 then @goto %Cycle
%End


Вложения:
Комментарий к файлу: Добавити в папку Digitals
bisector.tlb [4.64 Кб]
Скачиваний: 668
01.jpg
01.jpg [ 23.51 Кб | Просмотров: 52812 ]

_________________
Більшість хороших програмістів виконують свою роботу не тому, що очікують оплати або визнання, а тому, що отримують задоволення від програмування.
Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 211 ]  На страницу Пред.  1 ... 5, 6, 7, 8, 9, 10, 11 ... 15  След.

Часовой пояс: UTC + 2 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Русская поддержка phpBB