Создание макроса

@TPAKC327 · Регистрация: 03.04.2015

Студворк — интернет-сервис помощи студентам

Доброго времени суток господа.
Помогите решить проблему.
Есть информация в текстовом виде такого рода:

Begin Actor Class=StaticMeshActor
Begin Object Name="StaticMeshComponent0"
StaticMesh=StaticMesh'/Game/StatichMeshes/v_obj_s/O_Fence02-1'
RelativeLocation=(X=-97193.429688,Y=258821.125000,Z=-3612.254883)
RelativeRotation=(Pitch=1536,Yaw=-4624,Roll=1584)
End Actor

Таких строк в в файле может быть около 100 000

Как заставить эксейл считать и заменять значения Pitch/Yaw/Roll автоматически считать по формуле значение после знака =*на 360 и поделить на 65536, чтобы полученное значение автоматически поставилось вместо циферок на значение, что на примере выше.

Чтобы получилось такое:

Pitch=1536*360/65536=8,4375
Yaw=-4624*360/65536=-25,400390625
Roll=1584*360/65536=8,701171875

Чтобы в итоге был такой результат:

Begin Actor Class=StaticMeshActor
Begin Object Name="StaticMeshComponent0"
StaticMesh=StaticMesh'/Game/StatichMeshes/v_obj_s/O_Fence02-1'
RelativeLocation=(X=-97193.429688,Y=258821.125000,Z=-3612.254883)
RelativeRotation=(Pitch=8,4375,Yaw=-25,400390625,Roll=8,701171875)
End Actor

И если есть возможность, чтобы заместо запятой были точки RelativeRotation=(Pitch=8.4375,Yaw=-25.400390625,Roll=8.701171875)

А так же чтобы значение после точки не превышало шести значное число.

Загрузил файл в формате эксейля и на всякий случай в текстовом блоктоне.

@TPAKC327 · 11.04.2016, 16:53 **[ТС]**

Hugo121 - сейчас допроверю всё и опишу

@Hugo121 · 11.04.2016, 16:59

Сообщение от TPAKC327

Именно между цифрами на точки бы переставить

В полученных числах?
Если вопрос по сгенерированной строке - просто измените в тексте запятые на точки, а в полученных числах заменой поменяйте разделитель, если Ваш не годится.
Если по той строке, где я заменяю точки на запятые как просили - уберите замену, вернее можно убрать целиком эту ветку ElseIf

@TPAKC327 · 11.04.2016, 17:20 **[ТС]**

Вообщем всё проверил, нужно заместо запятых точки между цифрами что у RelativeLocation=(X=-56893,375000,Y=190358,578125,Z=-4374,849609)
RelativeRotation=(Pitch=0,Yaw=-270,Roll=0)

Меняю в скрипте путь и формат файла и он всё читает. Единственное это запятые нужно менять на точки

Чтобы вот так выглядило результат. А запятая перед Roll и Yaw осталось там же и не менялось ни на что
RelativeLocation=(X=-56893.375000,Y=190358.578125,Z=-4374.849609)
RelativeRotation=(Pitch=0,Yaw=-270,Roll=0)

Добавлено через 7 минут
t1 = Replace(arr(0), "RelativeRotation=(Pitch=". "") * 360 / 65536
t2 = Replace(arr(1), "Yaw=". "") * 360 / 65536
t3 = Replace(Replace(arr(2), ")", ""), "Roll=". "") * 360 / 65536
Поменял на точки после Ролл Яш и Питч

и удалил строку
ElseIf InStr(templine, "RelativeLocation=(") > 0 Then

Что то не помогло

Добавлено через 2 минуты
ВСЁ!!!! Сделал получилось!!!!!!! УРААААААА ВЫ САМЫЙ КЛАССНЫЙ, ОЧУМЕТЬ, ФАНТАСТИКА!

@Hugo121 · 11.04.2016, 17:21

Давайте пример файла, вечером дома гляну, сейчас уже некогда.

@TPAKC327 · 11.04.2016, 17:22 **[ТС]**

http://rghost.ru/8L9LkSrpT/image.png Вот результат!!!

Добавлено через 32 секунды
Hugo121 - Всё получилось!!! Вы сделали невероятное!

@Hugo121 · 11.04.2016, 17:23

Результат это хорошо, нужно исходник в файле, чтоб точно проверить.
Ну или может кто другой код пока подправит.

@TPAKC327 · 11.04.2016, 17:32 **[ТС]**

Кликните здесь для просмотра всего текста

' FSO Constants

t = Timer
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = -2

' Variables
Dim objFSO, objTS, objOTS, objfile, templine

' Instantiate the object
Set objFSO = CreateObject("Scripting.FileSystemObject ")

' open the text file read only
Set objTS = objFSO.OpenTextFile("C:\Temp\18_23.t3d", ForReading, False, TristateUseDefault)
' We now open the file to write it out
If objFSO.FileExists("c:\Temp\out.txt") Then
Set objOTS = objFSO.OpenTextFile("C:\Temp\out.txt", ForAppending)
Else
Set objfile = objFSO.CreateTextFile("C:\Temp\out.txt")
Set objfile = Nothing
Set objOTS = objFSO.OpenTextFile("C:\Temp\out.txt", ForAppending)
End If

Do While objTS.AtEndOfStream <> True
templine = objTS.ReadLine()
If InStr(templine, "RelativeRotation=(Pitch=") > 0 Then
arr = Split(templine, ",")
t1 = Replace(arr(0), "RelativeRotation=(Pitch=", "") * 360 / 65536
t2 = Replace(arr(1), "Yaw=", "") * 360 / 65536
t3 = Replace(Replace(arr(2), ")", ""), "Roll=", "") * 360 / 65536
objOTS.Writeline "RelativeRotation=(Pitch=" & t1 & ",Yaw=" & t2 & ",Roll=" & t3 & ")"

Else
objOTS.Writeline templine
End If
Loop

' Close all files after we read it in.
objTS.Close
Set objTS = Nothing
objOTS.Close
Set objOTS = Nothing
Set objFSO = Nothing
t = Timer - t
MsgBox "OK! Run in " & t

Исходный код кода.

Файл который не был использован - вот архив подкорректированных файлов, готовых для вашего скрипта http://rghost.ru/75xxFgCYS

@Hugo121 · 11.04.2016, 19:38

Т.е. всё получилось, код править не нужно? А то что-то архив файлов не качается...

Добавлено через 2 минуты
Если такая работа намечается ещё - можно доработать чтоб обрабатывало все файлы каталога и кидало результат в другой каталог под таким же именем (ну или с любым другим дополнением к имени).

@TPAKC327 · 11.04.2016, 20:00 **[ТС]**

Было бы здорово если бы была такая возможно как вы описали:

Кликните здесь для просмотра всего текста

Если такая работа намечается ещё - можно доработать чтоб обрабатывало все файлы каталога и кидало результат в другой каталог под таким же именем (ну или с любым другим дополнением к имени).
Hugo121 на форуме Сообщить модератору о нарушении

@Hugo121 · 11.04.2016, 20:21

Так дайте файлы для теста - тот архив смотрю уже удалён...

@TPAKC327 · 11.04.2016, 20:41 **[ТС]**

http://rghost.ru/6fc6wCWQH
Перезалил

@Hugo121 · 11.04.2016, 20:49

Проверяйте. Файлы из архива у меня обработало за 17 секунд.
Всё положить понятно куда, результаты будут понятно где

@TPAKC327 · 11.04.2016, 20:57 **[ТС]**

Проверил, делает вроде всё, но вот RelativeRotation=(Pitch=10,5029296875,Ya w=154,423828125,Roll=0) запятые, открыл код, а ElseIf уже и нету, как теперь сделать чтобы заместо запятой были точки в цифрах?

@Hugo121 · 11.04.2016, 21:03

У меня с точками, но это потому что у меня разделители такие.
Но исправить легко - когда получили t1, t2, t3 - навесьте им замену запятых на точки. Если прямо так не получится - сперва преобразуйте в стринг.
Ну а потом уже собирайте строку.
Типа

Visual Basic
1
2
3
4
t1 = Replace(arr(0), "RelativeRotation=(Pitch=", "") * 360 / 65536
t1=replace(t1, ",",".")
или
t1=replace(cstr(t1), ",",".")

Вообще как-то можно вывести в vbs индикацию процесса, но я не такой спец.
Но если код запускать как макрос в Экселе - можно там статусбар приладить, будет контроль что что-то делается и сколько ещё осталось.

@TPAKC327 · 11.04.2016, 21:24 **[ТС]**

При изменении кода, например строки t1 = Replace(arr(0), если заменить на t1 = Replace(arr(0). с точкой на конце, и сохнарить( делаю всё в блокнотике от виндовс) то файл не работает.
Также если делаю любое изменение(кроме удаления полностью строк\и) то всё равно не будет работать,
например взять поменять с запятой на точку, сохранить, вернуть назад через ctrl+z, и снова сохранить. То файл уже не работает, хотя по сути изменений я не делал.

А вы через какую программу делаете?

Shersh · 11.04.2016, 21:26

str добавить и всё, наверно -

Visual Basic
1
t1 =STR$( Replace(arr(0), "RelativeRotation=(Pitch=", "") * 360 / 65536)

@Hugo121 · 11.04.2016, 21:29

Visual Basic
1
t1=replace(cstr(t1), ",",".")

- тут нет точки в конце

Я правлю чем угодно, всегда работает. Но удобнее в Notepad++
Попробуйте править в редакторе VBA Экселя - поместите код между
sub tt()
сюда
end sub

Там и отладить легче, можно пошагово пройтись, и отступы поставить.

@TPAKC327 · 11.04.2016, 21:42 **[ТС]**

Через NotePad++ возвращает изменения назад в рабочее состояние, но пока не получается... Открыл Visual Studio тоже работает через неё информация, но пока нужного результата не могу достичь, пробую ещё.
Эксейль не обязательно, главное информацию чтобы можно было открыть, скопировать и вставить в Движок Анрила, через Эксейль была последняя надежда, а тут вот как ваш код готово делает и без эксейля, ещё бы решить головоломку с запятой и алелуя будет, пробую дальше

@Hugo121 · 11.04.2016, 21:54

Да я Эксель предлагаю не для того, чтоб в нём на листе гонять эти данные - Эксель можно использовать только как оболочку для этого же кода, даже без никаких изменений (только обрамить его как положено, чтоб работало).
Ну и как бонус - индикация процесса.

Добавлено через 6 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub tt()
 
' FSO Constants
 
    t = Timer
    Const ForReading = 1
    Const ForAppending = 8
    Const TristateUseDefault = -2
 
    ' Variables
    Dim objFSO, objTS, objOTS, objfile, templine
    Dim TheFolder, TheFiles, AFile, cnt
 
    ' Instantiate the object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    Set TheFolder = objFSO.GetFolder("c:\Temp\in")    'Каталог для обработки
    Set TheFiles = TheFolder.Files
 
    For Each AFile In TheFiles
        If LCase(objFSO.GetExtensionName(AFile.Path)) = "t3d" Then
            cnt = cnt + 1
            Application.StatusBar = "Обработка файла " & AFile.Name & " Осталось обработать " & TheFiles.Count - cnt
            ' open the text file read only
            Set objTS = objFSO.OpenTextFile(AFile, ForReading, False, TristateUseDefault)
            ' We now open the file to write it out
            If objFSO.FileExists("c:\Temp\out" & AFile.Name) Then objFSO.DeleteFile ("c:\Temp\out" & AFile.Name)
            Set objfile = objFSO.CreateTextFile("c:\Temp\out" & AFile.Name)
            Set objfile = Nothing
            Set objOTS = objFSO.OpenTextFile("c:\Temp\out" & AFile.Name, ForAppending)
 
            Do While objTS.AtEndOfStream <> True
                templine = objTS.ReadLine()
                If InStr(templine, "RelativeRotation=(Pitch=") > 0 Then
                    arr = Split(templine, ",")
                    t1 = Replace(arr(0), "RelativeRotation=(Pitch=", "") * 360 / 65536
                    t1 = Replace(CStr(t1), ",", ".")
                    t2 = Replace(arr(1), "Yaw=", "") * 360 / 65536
                    t2 = Replace(CStr(t2), ",", ".")
                    t3 = Replace(Replace(arr(2), ")", ""), "Roll=", "") * 360 / 65536
                    t3 = Replace(CStr(t3), ",", ".")
 
                    objOTS.Writeline "RelativeRotation=(Pitch=" & t1 & ",Yaw=" & t2 & ",Roll=" & t3 & ")"
                Else
                    objOTS.Writeline templine
                End If
            Loop
 
            ' Close all files after we read it in.
            objTS.Close
 
        End If
    Next
 
    Application.StatusBar = False
    Set objTS = Nothing
    objOTS.Close
    Set objOTS = Nothing
    Set objFSO = Nothing
    t = Timer - t
    MsgBox "OK! Run in " & t
 
End Sub

@TPAKC327 · 11.04.2016, 22:08 **[ТС]**

Всё!!!!!!!! 25_17.t3d взял квадрат как пробу = вошло идеально!
Мамочки дорогая....
Hugo121 - Долго код такой вы писали? Если изначально знать что нужно - сколько по времени на такой код нужно времени?

Новые блоги и статьи Все статьи Все блоги /
Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .	Оттачиваю умение писать js программы. russiannick 30.08.2026 Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .	мат медиц модель 30. презентация проекта anaschu 27.08.2026 хоп хоп хоп хидахоп, а я кладую))

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 16:53 [ТС]
	Hugo121 - сейчас допроверю всё и опишу 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 17:20 [ТС]
	Вообщем всё проверил, нужно заместо запятых точки между цифрами что у RelativeLocation=(X=-56893,375000,Y=190358,578125,Z=-4374,849609) RelativeRotation=(Pitch=0,Yaw=-270,Roll=0) Меняю в скрипте путь и формат файла и он всё читает. Единственное это запятые нужно менять на точки Чтобы вот так выглядило результат. А запятая перед Roll и Yaw осталось там же и не менялось ни на что RelativeLocation=(X=-56893.375000,Y=190358.578125,Z=-4374.849609) RelativeRotation=(Pitch=0,Yaw=-270,Roll=0) Добавлено через 7 минут t1 = Replace(arr(0), "RelativeRotation=(Pitch=". "") * 360 / 65536 t2 = Replace(arr(1), "Yaw=". "") * 360 / 65536 t3 = Replace(Replace(arr(2), ")", ""), "Roll=". "") * 360 / 65536 Поменял на точки после Ролл Яш и Питч и удалил строку ElseIf InStr(templine, "RelativeLocation=(") > 0 Then Что то не помогло Добавлено через 2 минуты ВСЁ!!!! Сделал получилось!!!!!!! УРААААААА ВЫ САМЫЙ КЛАССНЫЙ, ОЧУМЕТЬ, ФАНТАСТИКА! 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	11.04.2016, 17:21
	Давайте пример файла, вечером дома гляну, сейчас уже некогда. 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 17:22 [ТС]
	http://rghost.ru/8L9LkSrpT/image.png Вот результат!!! Добавлено через 32 секунды Hugo121 - Всё получилось!!! Вы сделали невероятное! 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	11.04.2016, 17:23
	Результат это хорошо, нужно исходник в файле, чтоб точно проверить. Ну или может кто другой код пока подправит. 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 17:32 [ТС]
	Кликните здесь для просмотра всего текста ' FSO Constants t = Timer Const ForReading = 1 Const ForAppending = 8 Const TristateUseDefault = -2 ' Variables Dim objFSO, objTS, objOTS, objfile, templine ' Instantiate the object Set objFSO = CreateObject("Scripting.FileSystemObject ") ' open the text file read only Set objTS = objFSO.OpenTextFile("C:\Temp\18_23.t3d", ForReading, False, TristateUseDefault) ' We now open the file to write it out If objFSO.FileExists("c:\Temp\out.txt") Then Set objOTS = objFSO.OpenTextFile("C:\Temp\out.txt", ForAppending) Else Set objfile = objFSO.CreateTextFile("C:\Temp\out.txt") Set objfile = Nothing Set objOTS = objFSO.OpenTextFile("C:\Temp\out.txt", ForAppending) End If Do While objTS.AtEndOfStream <> True templine = objTS.ReadLine() If InStr(templine, "RelativeRotation=(Pitch=") > 0 Then arr = Split(templine, ",") t1 = Replace(arr(0), "RelativeRotation=(Pitch=", "") * 360 / 65536 t2 = Replace(arr(1), "Yaw=", "") * 360 / 65536 t3 = Replace(Replace(arr(2), ")", ""), "Roll=", "") * 360 / 65536 objOTS.Writeline "RelativeRotation=(Pitch=" & t1 & ",Yaw=" & t2 & ",Roll=" & t3 & ")" Else objOTS.Writeline templine End If Loop ' Close all files after we read it in. objTS.Close Set objTS = Nothing objOTS.Close Set objOTS = Nothing Set objFSO = Nothing t = Timer - t MsgBox "OK! Run in " & t Исходный код кода. Файл который не был использован - вот архив подкорректированных файлов, готовых для вашего скрипта http://rghost.ru/75xxFgCYS 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	11.04.2016, 19:38
	Т.е. всё получилось, код править не нужно? А то что-то архив файлов не качается... Добавлено через 2 минуты Если такая работа намечается ещё - можно доработать чтоб обрабатывало все файлы каталога и кидало результат в другой каталог под таким же именем (ну или с любым другим дополнением к имени). 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 20:00 [ТС]
	Было бы здорово если бы была такая возможно как вы описали: Кликните здесь для просмотра всего текста Если такая работа намечается ещё - можно доработать чтоб обрабатывало все файлы каталога и кидало результат в другой каталог под таким же именем (ну или с любым другим дополнением к имени). Hugo121 на форуме Сообщить модератору о нарушении 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	11.04.2016, 20:21
	Так дайте файлы для теста - тот архив смотрю уже удалён... 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 20:41 [ТС]
	http://rghost.ru/6fc6wCWQH Перезалил 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 20:57 [ТС]
	Проверил, делает вроде всё, но вот RelativeRotation=(Pitch=10,5029296875,Ya w=154,423828125,Roll=0) запятые, открыл код, а ElseIf уже и нету, как теперь сделать чтобы заместо запятой были точки в цифрах? 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 21:24 [ТС]
	При изменении кода, например строки t1 = Replace(arr(0), если заменить на t1 = Replace(arr(0). с точкой на конце, и сохнарить( делаю всё в блокнотике от виндовс) то файл не работает. Также если делаю любое изменение(кроме удаления полностью строк\и) то всё равно не будет работать, например взять поменять с запятой на точку, сохранить, вернуть назад через ctrl+z, и снова сохранить. То файл уже не работает, хотя по сути изменений я не делал. А вы через какую программу делаете? 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 21:42 [ТС]
	Через NotePad++ возвращает изменения назад в рабочее состояние, но пока не получается... Открыл Visual Studio тоже работает через неё информация, но пока нужного результата не могу достичь, пробую ещё. Эксейль не обязательно, главное информацию чтобы можно было открыть, скопировать и вставить в Движок Анрила, через Эксейль была последняя надежда, а тут вот как ваш код готово делает и без эксейля, ещё бы решить головоломку с запятой и алелуя будет, пробую дальше 0

@TPAKC327 0 / 0 / 0 Регистрация: 03.04.2015 Сообщений: 45
	11.04.2016, 22:08 [ТС]
	Всё!!!!!!!! 25_17.t3d взял квадрат как пробу = вошло идеально! Мамочки дорогая.... Hugo121 - Долго код такой вы писали? Если изначально знать что нужно - сколько по времени на такой код нужно времени? 0