128
Приложение 1
Перечень документов на сварочный материал на сварочную ленту
Св-04Х20Н10Г2Б с сечением 0,5х60 мм.
Справочник наименований сварочных материалов
129
Справочник размеров сварочных материалов
Справочник нормативной документации
130
Приложение 2
Листинг программы
sub MainScript
call Con_ExecSQL.Con (lsRpt, "col2", "isobject_id", "col4")
end sub
Option Explicit
Sub Con(aData, obj_desc, obj_id, docyesno)
Dim lCon
Set lCon = Application.GetADOConnect()
call ExecSQL (aData, lCon, obj_desc, obj_id, docyesno)
end sub
Sub ExecSQL (aData, aCon, obj_desc, obj_id, docyesno)
Dim L, lRecSet, RC, id, data
RC = aData.RowCount()
For L = 1 to RC
id = aData.GetItem (L, obj_id)
Set lRecSet = aCon.Execute( "Select max( ID) from lsdbo.file_v Where object_reference_id = " &
id )
IF IsNull(lRecSet(0)) Then
data = "Нет"
Else
data = "Есть"
End IF
Call aData.SetItem(L, docyesno,data)
next
end sub
sub Gl2
que = msgbox ("Открыть в AdobeReader?", vbYesNo, "Запрос")
IF que = vbYes Then
call excel.proc2(LsRpt, "comp")
Else
call gl1
End If
end sub
sub Gl1
que = msgbox ("Открыть в AdobeReader?", vbYesNo, "Запрос")
IF que = vbYes Then
call AdobeReader.proc1(LsRpt, "comp")
End If
End sub
Option Explicit
sub proc1(aData, col)
Dim wrdapp , CC, TT, J, doc, ran, tabl, aCell
set wrdapp = CreateObject ("AdobeReader.Application")
set doc = pdfapp.Documents.Add
CC = aData.RowCount()
set ran = pdfapp.Selection.Range
set tabl = pdfapp.ActiveDocument.Tables.Add (ran,CC,2)
J = 1
For Each aCell In tabl.Columns(1).Cells
aCell.Select
TT = aData.GetItem (J, col)
pdfapp.Selection.TypeText TT
J = J+1
IF J > CC then
exit for
end if
Next
pdfapp.visible = True
call gl2
end sub
sub Main
call ConString.Con(LsRpt, "col7", "col8")
end sub
Option Explicit
sub Con(aData, mst, mst_list)
Dim RC, L, M, M_list, l2, l1
RC = aData.RowCount()
M_list = ""
L1 = 1
For L = 1 to RC
if L>1 and L = aData.FindGroupChange(L, 1) then
131
for l2=l1 to l-1
Call aData.SetItem(L2, mst_list,M_list)
next
M_list = ""
l1 = l
end if
M = aData.GetItem (L, mst)
if M_list<>"" then
M_list = M_list + ", "
end if
M_list = M_list + M
next
if M_list<>"" then
for l2=l1 to RC
Call aData.SetItem(L2, mst_list,M_list)
next
end if
end sub
Option Explicit
Dim gSelAcc ' Запрос к БД
sub AccountRetrieve
Dim lRow, lRecSet, aEmpty(), lCon, lCmd
if not IsObject(gSelAcc) then
' Подключиться к БД Координатора, если еще не подключены
Set lCon = CreateObject("ADODB.Connection")
Call lCon.Open("Provider=MSDASQL;Dsn=Trade_TestSQL10;uid=mainadmin;pwd=main")
' Сформировать запрос
Set lCmd = CreateObject("ADODB.Command")
lCmd.CommandText = "select Cast(id as varchar), number2, state, AccountSum " + _
"from lsdbo.Account where datedoc = ?"
lCmd.CommandType = 1 'adCmdText
lCmd.Prepared = True
lCmd.Parameters.Append lCmd.CreateParameter("aDate", 7) 'adDate
lCmd.ActiveConnection = lCon
Set gSelAcc = lCmd
end if
' Выполнить запрос к БД по указанной дате
gSelAcc("aDate") = LsJob.GetVarValue("aDate")
Set lRecSet = gSelAcc.Execute
' Очистить переменные
LsJob.SetVarValue "aID", aEmpty
LsJob.SetVarValue "aNumber", aEmpty
LsJob.SetVarValue "aState", aEmpty
LsJob.SetVarValue "aSum", aEmpty
' Считать данные по всем счетам и занести их в массивы построчно
lRow = 0
Do While Not lRecSet.EOF
LsJob.SetVarValue "aID", lRecSet(0).Value
LsJob.SetVarValue "aNumber", lRecSet(1).Value
LsJob.SetVarValue "aState", lRecSet(2).Value
LsJob.SetVarValue "aSum", lRecSet(3).Value
lRow = lRow + 1
lRecSet.MoveNext
Loop
end sub
if not IsObject(gSelAcc) then
' Подключиться к БД, если еще не подключены
Set lCon = Application.GetADOConnect()
' Сформировать запрос
. . .
' Выполнить запрос к БД
gSelAcc("aDate") = LsJob.GetVarValue("aDate")
Set lRecSet = gSelAcc.Execute
' Считать целиком результат запроса
lRow = 0
Do While Not lRecSet.EOF
if lRow mod 100 = 0 then
' Увеличить размер массивов для хранения результата
ReDim Preserve aID((lRow / 100 + 1) * 100)
ReDim Preserve aNumber((lRow / 100 + 1) * 100)
ReDim Preserve aState((lRow / 100 + 1) * 100)
ReDim Preserve aSum((lRow / 100 + 1) * 100)
end if
aID(lRow) = lRecSet(0).Value
aNumber(lRow) = lRecSet(1).Value
aState(lRow) = lRecSet(2).Value
aSum(lRow) = lRecSet(3).Value
lRow = lRow + 1
lRecSet.MoveNext
132
Loop
if lRow > 0 then
' Скорректировать размер массивов в соответствии с числом считанных строк
ReDim Preserve aID(lRow - 1)
ReDim Preserve aNumber(lRow - 1)
ReDim Preserve aState(lRow - 1)
ReDim Preserve aSum(lRow - 1)
end if
' Записать массивы в переменные работы
LsJob.SetVarValue "aID", aID
LsJob.SetVarValue "aNumber", aNumber
LsJob.SetVarValue "aState", aState
LsJob.SetVarValue "aSum", aSum
end sub
sub Run
' Выполнить изменение атрибутов
RunAttrib LsOperation.ObjectService
end sub
function RunAttrib(aObjSvc)
Dim oRoot, lDate
' Установить корневой объект
set oRoot = aObjSvc.GetObject(793987520900000) ' Замок
if not IsObject(oRoot) then
MsgBox "Объект не найден"
RunAttrib = false
exit function
end if
lDate = Date
' Запустить обработку дерева
InheritAttrib oRoot, lDate, "del_me.txt"
RunAttrib = true
end function
sub InheritAttrib(aObj, aDate, aFile)
Dim oLink, oLinks, oChild, lTypeID
' обработать все дочерние объекты
set oLinks = aObj.GetLinkedObjects(1, 1)
for each oLink in oLinks
set oChild = oLink.ChildObject
lTypeID = CCur(oChild.TypeID)
if lTypeID = 793987517900000 or lTypeID = 793987517600000 then ' Эскиз, Проект
' Установить атрибут "Дата окончания разработки документации" (ID: 9) объекту
oChild.SetAttrib 9, aDate
if aFile <> "" then
' Добавить атрибут "Файл" (ID: -6) объекту, если необходимо
oChild.SetAttrib -6, aFile
end if
end if
' Обработать все дочерние объекты (рекурсивно)
if lTypeID = 680515049901014 or lTypeID = 680515050001014 or _
lTypeID = 680515049801014 then 'Башня, Здание, Стена
' Обрабатывать потомки только объектов типа "Башня", "Здание", "Стена"
InheritAttrib oChild, aDate, aFile
end if
next
end sub
sub Run
Dim oObjSvc
' Создать сервис обработки объектов
set oObjSvc = Application.CreateObjectService
' Выполнить изменение атрибутов
if RunAttrib(oObjSvc) then
' Сохранить изменения
oObjSvc.Update
end if
end sub
Option Explicit 114
133
sub Load
Dim sVals, oObj, oAttribs, oItem
‘ Получить объект
set oObj = LsOperation.ObjectService.GetObject(LsOperation.GetVarValue("a_Object"))
‘ Получить значения атрибутов
set oAttribs = oObj.GetAttribs(LsOperation.GetVarValue("Attrib"))
‘ Сформировать список значений
sVals = ""
for each oItem in oAttribs
sVals = sVals + vbCrLf + CStr(oItem)
next
‘ Передать список значений в переменную действия
LsOperation.SetVarValue "Vals", Mid(sVals, 3)
end sub
sub Del
Dim sDel, oObj, oAttribs, oItem
‘ Получить объект
set oObj = LsOperation.ObjectService.GetObject(LsOperation.GetVarValue("a_Object"))
‘ Получить значения атрибутов
set oAttribs = oObj.GetAttribs(LsOperation.GetVarValue("Attrib"))
‘ Получить удаляемое значение
sDel = LsOperation.GetVarValue("Del")
‘ Найти удаляемое значение
for each oItem in oAttribs
if oItem.Value = sDel then
‘ Значение найдено, удалить его
oObj.DeleteAttrib oItem
exit for
end if
next
end sub
sub Run
Dim oPDM, oObjSvc
' Подключиться к API
set oPDM = CreateObject("LotsiaPDM.Application")
' Проверить подключение к БД
if oPDM.Connect() then
' Создать сервис обработки объектов
set oObjSvc = oPDM.CreateObjectService
' Выполнить изменение атрибутов
if RunAttrib(oObjSvc) then
' Сохранить изменения
oObjSvc.Update
end if
end if
end sub
