Аналитика

Цифровая фотограмметрия, картография и землеустройство
Текущее время: 29 мар 2024 16:37

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




Начать новую тему Ответить на тему  [ Сообщений: 25 ]  На страницу Пред.  1, 2
Автор Сообщение
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 02 дек 2020 23:52 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
ТОВ Аспект писал(а):
Як викликати скриптом вікно властивості лінії, таке як через Ctrl+D?
Код:
@ExecuteMenu CollectInputDistance

ТОВ Аспект писал(а):
Або підкажіть як маркованому відрізку змінити довжину.
Код:
$Obj=@Map.SelectedObject
@If $Obj=0 Then @Break
$PointsCount=@Map.Object[$Obj].Count
$I=1
@While $I<=$PointsCount %PointsLoop
$MState=@Map.Object[$Obj].GetPointMarked $I
@If $MState=0 Then @Goto %SkipPoint
$D=@Map.Object[$Obj].LineLength[$I]
$D=@Dialog.Ask Вкажiть потрiбну довжину лiнiї Default=$D Size=200
$A=@Map.Object[$Obj].LineAngle[$I]
;
$X=@Map.Object[$Obj].Point[$I].x
$Y=@Map.Object[$Obj].Point[$I].y
$Z=@Map.Object[$Obj].Point[$I].z
;
$X=@Calc Replace("$X",",",".")
$Y=@Calc Replace("$Y",",",".")
$A=@Calc Replace("$A",",",".")
$D=@Calc Replace("$D",",",".")
;
$Rad=$A*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$DX=$X+$ACos*$D
$ASin=@Calc Sin($Rad)
$DY=$Y+$ASin*$D
;
$Sep=@DecimalSeparator
$DX=@Calc Replace("$DX",".","$Sep")
$DX=@DequoteText $DX
$DY=@Calc Replace("$DY",".","$Sep")
$DY=@DequoteText $DY
$Z=@Calc Replace("$Z",".","$Sep")
$Z=@DequoteText $Z
;
$P=@Assign $DX $DY $Z
$I=$I+1
@Map.Object[$Obj].Point[$I]=$P
@Map.RefreshObject $Obj
;
$N=$I+1
@If $N>$PointsCount Then @Goto %SkipPoint
$MState=@Map.Object[$Obj].GetPointMarked $N
@If $MState=1 Then $I=$I-1
;
%SkipPoint
$I=$I+1
%PointsLoop

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


Последний раз редактировалось Руслан Пархуць 03 дек 2020 13:50, всего редактировалось 2 раз(а).

Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 03 дек 2020 09:30 
Эксперт
Эксперт

Зарегистрирован:
29 окт 2012 12:15
Сообщения: 99
Откуда: Запорізька область, м. Кам'янка-Дніпровська
Не очікував що для цього такий путь треба прокласти. Велика вам подяка за скрипт.


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 03 дек 2020 13:52 
Гуру
Гуру
Аватара пользователя

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

:) нема за що, трохи пiдкорегував скрипт на рахунок довжини, яку потрiбно змiнити (щоб по замовчуванню ставило iснуючу) i забрав зайве дiалогове вiкно (тестував i забув забрати).

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


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 03 дек 2020 20:46 
Гуру
Гуру

Зарегистрирован:
01 фев 2013 17:16
Сообщения: 109
Дуже дякую.


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 04 дек 2020 10:21 
Эксперт
Эксперт

Зарегистрирован:
29 окт 2012 12:15
Сообщения: 99
Откуда: Запорізька область, м. Кам'янка-Дніпровська
Вчора за допомогою скрипту з попереднього посту порадів що нарешті витягнувши ділянку в ин4 не будуть напружувати ці довгі вуси суміжників :D .
Скрипт вчора працював сьогодні вже не працює. Прошу допомоги.
Скрипт з попереднього посту знаходиться в %Script.Test.Button4 замість строки 8-9 $D=5.
$L=@Map.Layers.FindByID ID70010
$File=@Map.Filename
$ID=@ExtractFileExt $File
@if ("$ID"=".dmf") and ("$L">"1") then $ID=70010
@if $ID=.xml then $ID=70010
@if $ID=.in4 then $ID=50000
$Nej=0
$A1=@Map.Count
$CC=0
%Loop
$Nej=$Nej+1
$LID=@Map.Object[$Nej].LayerID
@if $LID<>$ID then @Goto %Continue
$CC=$CC+1
@Map.SelectObject $Nej
$B=@Map.SelectedObject
$F=@Map.Object[$B].Count
$F1=$F-1
@Map.Selected.MarkPoints $F1
@Map.Selected.MarkPoints $F
%Script.Test.Button4
@Map.Object[$B].SetPointMarked $F1 0
@Map.Object[$B].SetPointMarked $F 0
@Map.Object[$B].Reverse
@Map.Selected.MarkPoints $F1
@Map.Selected.MarkPoints $F
%Script.Test.Button4
@Map.Object[$B].SetPointMarked $F1 0
@Map.Object[$B].SetPointMarked $F 0
@Map.DeselectObject $Nej
%Continue
@if $Nej<$A1 then @Goto %Loop
Мета цього скрипту змінити довжину вусиків суміжників


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 04 дек 2020 11:06 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
ТОВ Аспект писал(а):
Вчора за допомогою скрипту з попереднього посту порадів що нарешті витягнувши ділянку в ин4 не будуть напружувати ці довгі вуси суміжників :D .
Скрипт вчора працював сьогодні вже не працює. Прошу допомоги.

Цей скрипт на кнопку
Код:
$L=@Map.Layers.FindByID ID70010
$File=@Map.Filename
$ID=@ExtractFileExt $File
@if ("$ID"=".dmf") and ("$L">"1") then $ID=70010
@if $ID=.xml then $ID=70010
@if $ID=.in4 then $ID=50000
$Nej=0
$A1=@Map.Count
$CC=0
%Loop
$Nej=$Nej+1
$LID=@Map.Object[$Nej].LayerID
@if $LID<>$ID then @Goto %Continue
$CC=$CC+1
@Map.SelectObject $Nej
$F=@Map.Object[$Nej].Count
$F1=$F-1
;@Map.Selected.MarkPoints $F1
;@Map.Selected.MarkPoints $F
@Map.Object[$Nej].SetPointMarked $F1 1
@Map.Object[$Nej].SetPointMarked $F 1
%Library.Sample
;%Script.Test.Button4
@Map.Object[$Nej].SetPointMarked $F1 0
@Map.Object[$Nej].SetPointMarked $F 0
@Map.Object[$Nej].Reverse
;@Map.Selected.MarkPoints $F1
;@Map.Selected.MarkPoints $F
@Map.Object[$Nej].SetPointMarked $F1 1
@Map.Object[$Nej].SetPointMarked $F 1
%Library.Sample
;%Script.Test.Button4
@Map.Object[$Nej].SetPointMarked $F1 0
@Map.Object[$Nej].SetPointMarked $F 0
@Map.DeselectObject $Nej
%Continue
@if $Nej<$A1 then @Goto %Loop

а цей - на iншу (але прописати її в кодi, або, як зараз зроблено - в папцi Library створюєте файл sample.dsf i код записуєте в нього)
Код:
$Obj=@Map.SelectedObject
@If $Obj=0 Then @Break
$PointsCount=@Map.Object[$Obj].Count
$I=1
@While $I<=$PointsCount %PointsLoop
$MState=@Map.Object[$Obj].GetPointMarked $I
@If $MState=0 Then @Goto %SkipPoint
;$D=@Dialog.Ask Вкажiть потрiбну довжину лiнiї Default=10 Size=200
; значення за замовчуванням 5
$D=5
$A=@Map.Object[$Obj].LineAngle[$I]
;
$X=@Map.Object[$Obj].Point[$I].x
$Y=@Map.Object[$Obj].Point[$I].y
$Z=@Map.Object[$Obj].Point[$I].z
;
$X=@Calc Replace("$X",",",".")
$Y=@Calc Replace("$Y",",",".")
$A=@Calc Replace("$A",",",".")
$D=@Calc Replace("$D",",",".")
;
$Rad=$A*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$DX=$X+$ACos*$D
$ASin=@Calc Sin($Rad)
$DY=$Y+$ASin*$D
;
$Sep=@DecimalSeparator
;@Dialog.Message $Sep
$DX=@Calc Replace("$DX",".","$Sep")
$DX=@DequoteText $DX
$DY=@Calc Replace("$DY",".","$Sep")
$DY=@DequoteText $DY
$Z=@Calc Replace("$Z",".","$Sep")
$Z=@DequoteText $Z
;
$P=@Assign $DX $DY $Z
$I=$I+1
@Map.Object[$Obj].Point[$I]=$P
@Map.RefreshObject $Obj
;
$N=$I+1
@If $N>$PointsCount Then @Goto %SkipPoint
$MState=@Map.Object[$Obj].GetPointMarked $N
@If $MState=1 Then $I=$I-1
;
%SkipPoint
$I=$I+1
%PointsLoop

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


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 04 дек 2020 11:40 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
Я б зробив це трохи по iншому, без Selected. Даю повний код, але його можна спростити, перемiстивши повторюванi процедури в окрему бiблiотеку.
Код:
$L=@Map.Layers.FindByID ID70010
$File=@Map.Filename
$ID=@ExtractFileExt $File
@if ("$ID"=".dmf") and ("$L">"1") then $ID=70010
@if $ID=.xml then $ID=70010
@if $ID=.in4 then $ID=50000
$Nej=0
$A1=@Map.Count
$CC=0
%Loop
$Nej=$Nej+1
$LID=@Map.Object[$Nej].LayerID
@if $LID<>$ID then @Goto %Continue
;$CC=$CC+1
;@Map.SelectObject $Nej
$F=@Map.Object[$Nej].Count
; перший вiдрiзок 2-1
$PT=2
; потрiбна довжина вiдрiзка
$D=5
$A=@Map.Object[$Nej].LineAngle[1]
$Sep=@DecimalSeparator
$A=@Calc Replace("$A",".","$Sep")
$A=$A+180
; ----------------------------------------------
; це можна винести в окрему бiблiотеку (щоб не повторювати двiчi)
; ----------------------------------------------
$X=@Map.Object[$Nej].Point[$PT].x
$Y=@Map.Object[$Nej].Point[$PT].y
$Z=@Map.Object[$Nej].Point[$PT].z
;
$X=@Calc Replace("$X",",",".")
$Y=@Calc Replace("$Y",",",".")
$A=@Calc Replace("$A",",",".")
$D=@Calc Replace("$D",",",".")
;
$Rad=$A*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$DX=$X+$ACos*$D
$ASin=@Calc Sin($Rad)
$DY=$Y+$ASin*$D
;
$Sep=@DecimalSeparator
;@Dialog.Message $Sep
$DX=@Calc Replace("$DX",".","$Sep")
$DX=@DequoteText $DX
$DY=@Calc Replace("$DY",".","$Sep")
$DY=@DequoteText $DY
$Z=@Calc Replace("$Z",".","$Sep")
$Z=@DequoteText $Z
;
$P=@Assign $DX $DY $Z
@Map.Object[$Nej].Point[1]=$P
;
; потрiбна довжина вiдрiзка
$D=5
; ----------------------------------------------
; останнiй вiдрiзок N(-1)-N
$PT=$F-1
$A=@Map.Object[$Nej].LineAngle[$PT]
; ----------------------------------------------
; це можна винести в окрему бiблiотеку (щоб не повторювати двiчi)
; ----------------------------------------------
$X=@Map.Object[$Nej].Point[$PT].x
$Y=@Map.Object[$Nej].Point[$PT].y
$Z=@Map.Object[$Nej].Point[$PT].z
;
$X=@Calc Replace("$X",",",".")
$Y=@Calc Replace("$Y",",",".")
$A=@Calc Replace("$A",",",".")
$D=@Calc Replace("$D",",",".")
;
$Rad=$A*3.1415926535897932384626433832795028841971/180
$ACos=@Calc Cos($Rad)
$DX=$X+$ACos*$D
$ASin=@Calc Sin($Rad)
$DY=$Y+$ASin*$D
;
$Sep=@DecimalSeparator
;@Dialog.Message $Sep
$DX=@Calc Replace("$DX",".","$Sep")
$DX=@DequoteText $DX
$DY=@Calc Replace("$DY",".","$Sep")
$DY=@DequoteText $DY
$Z=@Calc Replace("$Z",".","$Sep")
$Z=@DequoteText $Z
;
$P=@Assign $DX $DY $Z
@Map.Object[$Nej].Point[$F]=$P
; ----------------------------------------------
@Map.RefreshObject $Nej
;
%Continue
@if $Nej<$A1 then @Goto %Loop

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


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 04 дек 2020 13:39 
Эксперт
Эксперт

Зарегистрирован:
29 окт 2012 12:15
Сообщения: 99
Откуда: Запорізька область, м. Кам'янка-Дніпровська
Перемінну $D теж в бібліотеку? Якщо так то її можливо буде змінити?


Вернуться к началу
 Профиль Отправить email  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 04 дек 2020 13:55 
Гуру
Гуру
Аватара пользователя

Зарегистрирован:
22 сен 2007 16:09
Сообщения: 382
Откуда: м.Львiв
ТОВ Аспект писал(а):
Перемінну $D теж в бібліотеку? Якщо так то її можливо буде змінити?

В бiблiотецi прописуєте на початку наступне:
Код:
@if $PARAMETERS= then @Break
$D=@StringPart 1 $PARAMETERS

i закоментовуєте рядок в кодi, де є присвоєння значення змiннiй $D, тобто:
Код:
; значення за замовчуванням 5
; $D=5
тодi виклик бiблiотеки використовуєте наступним чином:
Код:
%Library.Sample 5

де 5-довжина вiдрiзка

P.S. Привiв до порядку, в параметрi вказується ID об'єкту, номер точки (+/- напрямок , в якому змiнюється довжина (якщо вiд'ємне значення, тодi зворотнiй)) i сама довжина вiдрiзку


Вложения:
Комментарий к файлу: Бiблiотека (розархiвувати i скопiювати в папку з програмою Digitals\Library)
polar2.zip [867 байт]
Скачиваний: 205
Комментарий к файлу: Кнопка (скопiювати в папку з програмою Digitals)
Sample.tlb [3.25 Кб]
Скачиваний: 225

_________________
Більшість хороших програмістів виконують свою роботу не тому, що очікують оплати або визнання, а тому, що отримують задоволення від програмування.
Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Скрипти Допоможіть будь ласка.)
СообщениеДобавлено: 07 дек 2020 10:00 
Эксперт
Эксперт

Зарегистрирован:
29 окт 2012 12:15
Сообщения: 99
Откуда: Запорізька область, м. Кам'янка-Дніпровська
Дякую за допомогу. Ваш підхід значно по краще


Вернуться к началу
 Профиль Отправить email  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 25 ]  На страницу Пред.  1, 2

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


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

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


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

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