'================================ 'GLOBAL VAR '================================ scale = 10 'ìàñøòàá font = "Lucida Console" 'øðèôò "Arial" font_size = 6 ' ðàçìåð øðèôòà (ïî óìîë÷àíèþ = 6) PrintTxtNode = true ' true/false ýêñïîðò äàííûõ - óçëû PrintTxtLine = true ' true/false ýêñïîðò äàííûõ - âåòâè PrintSel = false 'true/false ýêñïîðòèðîâàòü ÒÎËÜÊÎ îòìå÷åííûå óçëû (ïîëå sel) SaveFile = "C:\projects\test_grf.svg" 'ïîëíûé ïóòü ê ôàéëó *.svg wx = 0 'ñìåùåíèå wy = -4 width = 2560 height = 2560 '=============================== txt_scl = 6*(10/scale) grid = 1*scale xmlbase = ""& _ ""& _ ""& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ " "& _ "" svgNS="http://www.w3.org/2000/svg" set SVGDoc = CreateObject("Msxml2.DOMDocument.6.0") SVGDoc.async = false SVGDoc.ValidateOnParse = false SVGDoc.loadXML(xmlbase) SVGDoc.setProperty "SelectionNamespaces", "xmlns:xsl='http://www.w3.org/1999/XSL/Transform'" SVGDoc.setProperty "SelectionLanguage", "XPath" set root = SVGDoc.documentElement MAIN ' G Sub AddG(nGroup) nGroup.setAttribute "fill", "darkred" nGroup.setAttribute "stroke", "darkred" nGroup.setAttribute "stroke-width", "1" End Sub Sub AddGVetv(nGroup) nGroup.setAttribute "fill", "blue" nGroup.setAttribute "stroke", "blue" nGroup.setAttribute "stroke-width", "1" End Sub Sub AddGtxt(nGroup) nGroup.setAttribute "font-family", font nGroup.setAttribute "font-size", font_size nGroup.setAttribute "fill", "black" nGroup.setAttribute "stroke", "black" nGroup.setAttribute "stroke-width", ".3" End Sub Sub AddLine(nGroup, vhb, vhe, nprb, npre, Mizg, x1, y1, x2, y2, tip, wid1, sta, nGrouptxt, txt_slb, txt_sle, x_slb, y_slb, x_sle, y_sle, bang, eang, cvizb, cvize, plb) str ="" midstr = "" endstr1 = " " endstr = " " set newLine = SVGDoc.createNode(1, "path", svgNS) If CLng(vhb) > 0 Then xA = x1+nprb-wx yA = y1-wy else xA = x1-wx yA = y1-nprb-wy End If str = "M "& CStr(xA*scale) &" "& CStr(yA*scale)&" " x1txt = (xA*scale+CLng(x_slb)\txt_scl) y1txt = (yA*scale+CLng(y_slb)\txt_scl) NumR = UBOUND(Mizg) - LBOUND(Mizg) For ii = 0 to NumR-1 midstr = midstr & "L "& CStr((xA+Mizg(ii,0))*scale) &" "& CStr((yA+Mizg(ii,1))*scale) &" " Next If CLng(vhe) > 0 Then if NumR >=0 Then endstr1 = "L " & CStr((x2+npre+Mizg(NumR,0)-wx)*scale) &" "& CStr((y2+Mizg(NumR,1)-wy)*scale)&" " endstr = endstr1 &"L " & CStr((x2+npre-wx)*scale) &" "& CStr((y2-wy)*scale) xForif = x2+npre+Mizg(NumR,0) x2txt = ((x2+npre-wx)*scale+CLng(x_sle)\txt_scl) y2txt = ((y2-wy)*scale+CLng(y_sle)\txt_scl) else if NumR >=0 Then endstr1 = "L " & CStr((x2+Mizg(NumR,0)-wx)*scale) &" "& CStr((y2+Mizg(NumR,1)-npre-wy)*scale)&" " endstr = endstr1 &"L " & CStr((x2-wx)*scale) &" "& CStr((y2-npre-wy)*scale) xForif = x2+Mizg(NumR,0) x2txt = ((x2-wx)*scale+CLng(x_sle)\txt_scl) y2txt = ((y2-npre-wy)*scale+CLng(y_sle)\txt_scl) End If if (xA+Mizg(0,0)) > xForif Then cvizb = 3 cvize = 1 if plb = 0 Then plb = 1 Else plb = 0 ElseIf (xA+Mizg(0,0)) = xForif Then if y1txt < y2txt Then cvizb = 3 cvize = 1 if plb = 0 Then plb = 1 Else plb = 0 End If End IF if PrintTxtLine Then AddTextVetv nGrouptxt,x1txt, y1txt, txt_slb, bang, cvizb, plb AddTextVetv nGrouptxt,x2txt, y2txt, txt_sle, eang, cvize, plb End If newLine.setAttribute "d", str & midstr & endstr newLine.setAttribute "fill", "none" if sta <> 0 Then newLine.setAttribute "stroke-dasharray", "5,3" if wid1 > 1 Then newLine.setAttribute "stroke-width", wid1 nGroup.appendChild(newLine) If CLng(tip) = 1 Then set newLineTR = SVGDoc.createNode(1, "use", svgNS) If NumR = 1 Then If CLng(vhe) > 0 Then x = (x2+npre+Mizg(NumR,0)-wx)*scale - (xA+Mizg(0,0))*scale y = (y2+Mizg(NumR,1)-wy)*scale - (yA+Mizg(0,1))*scale cx = (x2+npre+Mizg(NumR,0)-wx)*scale + (xA+Mizg(0,0))*scale cy = (y2+Mizg(NumR,1)-wy)*scale + (yA+Mizg(0,1))*scale else x = (x2+Mizg(NumR,0)-wx)*scale - (xA+Mizg(0,0))*scale y = (y2+Mizg(NumR,1)-npre-wy)*scale - (yA+Mizg(0,1))*scale cx = (x2+Mizg(NumR,0)-wx)*scale + (xA+Mizg(0,0))*scale cy = (y2+Mizg(NumR,1)-npre-wy)*scale + (yA+Mizg(0,1))*scale End If ElseIf NumR = 0 Then If CLng(vhe) > 0 Then x = (x2+npre+Mizg(NumR,0)-wx)*scale - (xA)*scale y = (y2+Mizg(NumR,1)-wy)*scale - (yA)*scale cx = (x2+npre+Mizg(NumR,0)-wx)*scale + (xA)*scale cy = (y2+Mizg(NumR,1)-wy)*scale + (yA)*scale else x = (x2+Mizg(NumR,0)-wx)*scale - (xA)*scale y = (y2+Mizg(NumR,1)-npre-wy)*scale - (yA)*scale cx = (x2+Mizg(NumR,0)-wx)*scale + (xA)*scale cy = (y2+Mizg(NumR,1)-npre-wy)*scale + (yA)*scale End If ElseIf NumR = -1 Then If CLng(vhe) > 0 Then x = (x2+npre-wx)*scale - (xA)*scale y = (y2+-wy)*scale - (yA)*scale cx = (x2+npre-wx)*scale + (xA)*scale cy = (y2-wy)*scale + (yA)*scale else x = (x2-wx)*scale - (xA)*scale y = (y2-npre-wy)*scale - (yA)*scale cx = (x2-wx)*scale + (xA)*scale cy = (y2-npre-wy)*scale + (yA)*scale End If Else x = (xA+Mizg(1,0))*scale - (xA+Mizg(0,0))*scale y = (yA+Mizg(1,1))*scale - (yA+Mizg(0,1))*scale cx = (xA+Mizg(1,0))*scale + (xA+Mizg(0,0))*scale cy = (yA+Mizg(1,1))*scale + (yA+Mizg(0,1))*scale End IF if x <> 0 Then angl = CLng(180 * Atn(y/x)/3.14) else angl = 90 End If newLineTR.setAttribute "transform", "translate("& CStr(cx\2) &","& CStr(cy\2) &") rotate("& angl &")" newLineTR.setAttribute "xlink:href", "#trans" nGroup.appendChild(newLineTR) End If End Sub Sub AddLineVH(nGroup, x1, y1, np, st) If CLng(np) > 0 Then tip = "h" else tip = "v" End If set newLine = SVGDoc.createNode(1, "path", svgNS) xt = (x1-wx)*scale yt = (y1-wy)*scale newLine.setAttribute "d", "M "& CStr(xt) &" "& CStr(yt) &" "& tip &" "& CStr(np*scale) if st <> 0 Then newLine.setAttribute "stroke-dasharray", "5,3" nGroup.appendChild(newLine) if xt > width Then width = xt if yt > height Then height = yt End Sub Sub AddFig(nGroup, x1, y1, np, size, idFig, nprif) set newLine = SVGDoc.createNode(1, "use", svgNS) If CLng(np) > 0 Then If CLng(size) > 0 Then angl = "0" else angl = "180" End If newLine.setAttribute "transform", "translate("& CStr((x1+nprif-wx)*scale) &","& CStr((y1-wy)*scale) &") rotate("& angl &")" else If CLng(size) > 0 Then angl = "-90" else angl = "90" End If newLine.setAttribute "transform", "translate("& CStr((x1-wx)*scale) &","& CStr((y1-nprif-wy)*scale) &") rotate("& angl &")" End If newLine.setAttribute "xlink:href", "#"& CStr(idFig) nGroup.appendChild(newLine) End Sub Sub AddText(nGroup, x, y, ang, txt, viz) set newLine = SVGDoc.createNode(1, "text", svgNS) if CLng(ang) <> 0 Then if (viz = 0 or viz = 1) Then newLine.setAttribute "text-anchor", "end" x = x + font_size ElseIf (viz = 20 or viz = 21) Then x = x + (font_size\2) ElseIf (viz = 28 or viz = 29) Then newLine.setAttribute "text-anchor", "end" x = x + (font_size\2) End If newLine.setAttribute "transform", "translate("& CStr(x) &","& CStr(y) &") rotate("& CStr(ang) &")" Else if (viz = 0 or viz = 1) Then newLine.setAttribute "text-anchor", "end" y = y + font_size ElseIf (viz = 4 or viz = 5) Then y = y + font_size ElseIf (viz = 8 or viz = 9) Then newLine.setAttribute "text-anchor", "end" ElseIf (viz = 16 or viz = 17) Then newLine.setAttribute "text-anchor", "end" y = y + (font_size\2) ElseIf (viz = 20 or viz = 21) Then newLine.setAttribute "text-anchor", "middle" ElseIf (viz = 24 or viz = 25) Then y = y + (font_size\2) ElseIf (viz = 28 or viz = 29) Then newLine.setAttribute "text-anchor", "middle" y = y + font_size End If newLine.setAttribute "x", CStr(x) newLine.setAttribute "y", CStr(y) End If newLine.text = CStr(txt) nGroup.appendChild(newLine) End Sub Sub AddTextVetv(nGrouptxt,x, y, txt, ang, cviz, plb) set nLine = SVGDoc.createNode(1, "text", svgNS) IF cviz=3 Then nLine.setAttribute "text-anchor", "end" End IF if plb = 0 Then txt = CStr("<-") & txt Else txt = txt & CStr("->") End If if CLng(ang) <> 0 Then nLine.setAttribute "transform", "translate("& CStr(x) &","& CStr(y) &") rotate("& CStr(ang) &")" Else nLine.setAttribute "x", x nLine.setAttribute "y", y End If nLine.text = CStr(txt) nGrouptxt.appendChild(nLine) End Sub Class Point public x public y public vh public col public na End class '====================================================================== Sub MAIN set graph_node = Rastr.Tables("graph_node") set k_x = graph_node.Cols("k_x") set k_y = graph_node.Cols("k_y") set ny = graph_node.Cols("ny") set col_Npri = graph_node.Cols("npri") set col_ind_fig = graph_node.Cols("ind_fig") set col_ind_text = graph_node.Cols("ind_text") set graph_figur = Rastr.Tables("graph_figur") set col_size = graph_figur.Cols("size") set col_tip = graph_figur.Cols("tip") set col_zapret = graph_figur.Cols("zapret") set col_fnpr = graph_figur.Cols("npr") set graph_txt = Rastr.Tables("graph_text") set col_w_x = graph_txt.Cols("w_x") set col_w_y = graph_txt.Cols("w_y") set col_ugol = graph_txt.Cols("ugol") set col_viz = graph_txt.Cols("viz") set graph_settext = Rastr.Tables("graph_settext") set graph_settext_tip = graph_settext.Cols("tip") set graph_settext_zapret = graph_settext.Cols("zapret") set graph_settext_ntip = graph_settext.Cols("ntip") set tbl_node = Rastr.Tables("node") set col_ny = tbl_node.Cols("ny") set col_name = tbl_node.Cols("name") set col_vras = tbl_node.Cols("vras") set col_sn = tbl_node.Cols("sn") set col_sg = tbl_node.Cols("sg") set col_ssh = tbl_node.Cols("ssh") set col_delta = tbl_node.Cols("delta") set col_sta = tbl_node.Cols("sta") set col_sel = tbl_node.Cols("sel") set col_na = tbl_node.Cols("na") set graph_com = Rastr.Tables("graph_com") set col_uh_col = graph_com.Cols("uh_col") set col_ar_col = graph_com.Cols("ar_col") color = 0 ' 0 - default, 1 - U, 2 - Ar set d_color = CreateObject( "Scripting.Dictionary" ) if col_ar_col.Z(0) = 0 Then set graph_area = Rastr.Tables("graph_area") set col_graph_na = graph_area.Cols("na") set col_graph_col = graph_area.Cols("color") For i=0 to graph_area.count - 1 strt = Hex(col_graph_col.Z(i)) strt = String(6 - Len(strt), "0") & strt strt_r = Right(strt,2) strt_l = Left(strt,2) strt_m = Mid(strt, 3, 2) hxstr = strt_r & strt_m & strt_l d_color.Add col_graph_na.Z(i), hxstr set newGroup = SVGDoc.createNode(1, "g", svgNS) newGroup.setAttribute "na", "na_" & CStr(col_graph_na.Z(i)) newGroup.setAttribute "fill", "#" & hxstr newGroup.setAttribute "stroke", "#" & hxstr root.appendChild(newGroup) Next End If set d_node = CreateObject( "Scripting.Dictionary" ) num_row_tabl = graph_node.count set newGroupAll = SVGDoc.createNode(1, "g", svgNS) AddG(newGroupAll) set newGroupAllVetv = SVGDoc.createNode(1, "g", svgNS) AddGVetv(newGroupAllVetv) set newGrouptxt = SVGDoc.createNode(1, "g", svgNS) AddGtxt(newGrouptxt) For i = 0 TO num_row_tabl - 1 kx = CLng(k_x.Z(i)) ky = CLng(k_y.Z(i)) pny = ny.Z(i) Npri = col_Npri.Z(i) n_fig_in_tabl = CLng(col_ind_fig.Z(i)) find_nod = 0 ccol = -1 For n_nod = 0 to tbl_node.Count-1 If CLng(pny) = CLng(col_ny.Z(n_nod)) Then find_nod = 1 Exit For End If Next If find_nod = 1 Then sta = CLng(col_sta.Z(n_nod)) if PrintSel Then sel = CLng(col_sel.Z(n_nod)) Else sel = -1 End If if sel <> 0 Then IF d_color.Exists(col_na.Z(n_nod)) Then ccol = d_color.Item(col_na.Z(n_nod)) set newGrouptemp = root.SelectSingleNode("//*[@na='na_"& CStr(col_na.Z(n_nod)) &"']") if TypeName(newGrouptemp) <> "Nothing" Then set newGroup = newGrouptemp Else set newGroup = newGroupAll End If Else set newGroup = newGroupAll ccol = -1 End If AddLineVH newGroup, kx, ky, Npri, sta For nf = 0 to 2 If CLng(col_zapret.Z(n_fig_in_tabl+nf)) <> 1 and sta = 0 Then AddFig newGroup, kx, ky, Npri, col_size.Z(n_fig_in_tabl+nf), col_tip.Z(n_fig_in_tabl+nf), col_fnpr.Z(n_fig_in_tabl+nf) End If Next IF PrintTxtNode Then ntxt = col_ind_text.Z(i) For num_settxt = 0 to 6 If CInt(graph_settext_zapret.Z(num_settxt)) = 0 Then x_txt = ((kx-wx)*scale+CLng(col_w_x.Z(ntxt+num_settxt))\txt_scl) y_txt = ((ky-wy)*scale+CLng(col_w_y.Z(ntxt+num_settxt))\txt_scl) cviz = CLng(col_viz.Z(ntxt+num_settxt)) AddText newGrouptxt, x_txt, y_txt, col_ugol.Z(ntxt+num_settxt), tbl_node.Cols(CStr(graph_settext_tip.Z(num_settxt))).ZS(n_nod), cviz End If Next End If set cPoint = new Point cPoint.x = kx cPoint.y = ky cPoint.vh = Npri cPoint.col = ccol cPoint.na = col_na.Z(n_nod) If Not d_node.Exists(pny) Then d_node.Add pny, cPoint End IF set cPoint = nothing End If End If Next set graph_vetv = Rastr.Tables("graph_vetv") set col_ip = graph_vetv.Cols("ip") set col_iq = graph_vetv.Cols("iq") set col_Nizg = graph_vetv.Cols("nizg") set col_Nprb = graph_vetv.Cols("nprb") set col_Npre = graph_vetv.Cols("npre") set col_tip = graph_vetv.Cols("tip") set col_wid1 = graph_vetv.Cols("wid1") set col_ind_text = graph_vetv.Cols("ind_text") set tabl_vetv = Rastr.Tables("vetv") set col_vetv_ip = tabl_vetv.Cols("ip") set col_vetv_iq = tabl_vetv.Cols("iq") set col_slb = tabl_vetv.Cols("slb") set col_sle = tabl_vetv.Cols("sle") set col_sta = tabl_vetv.Cols("sta") set col_signP = tabl_vetv.Cols("signP") For i=0 to graph_vetv.Size-1 ip = col_ip.Z(i) iq = col_iq.Z(i) IF d_node.Exists(ip) and d_node.Exists(iq) Then Nprb = col_Nprb.Z(i) Npre = col_Npre.Z(i) Nizg = col_Nizg.Z(i) If Nizg > 0 Then ReDim aIzg(Nizg-1,1) Else ReDim aIzg(1,1) aIzg(0,0) = 0 aIzg(0,1) = 0 End If For n=0 to Nizg-1 If n <= 3 Then aIzg(n,0) = graph_vetv.Cols("izg"& CStr(n+1) &"_x").Z(i) aIzg(n,1) = graph_vetv.Cols("izg"& CStr(n+1) &"_y").Z(i) else Exit For End If Next If Nizg >= 4 Then strArr = Split(graph_vetv.Cols("izg_other").Z(i), ";", -1, 1) nn = 4 For n = 4 to Nizg-1 aIzg(n,0) = CLng(strArr(nn-n)) nn = nn + 1 aIzg(n,1) = CLng(strArr(nn-n)) nn = nn + 2 Next End If find_vetv = 0 For n_vetv = 0 to tabl_vetv.Count-1 If CLng(ip) = CLng(col_vetv_ip.Z(n_vetv)) and CLng(iq) = CLng(col_vetv_iq.Z(n_vetv)) Then find_vetv = 1 Exit For End If Next if find_vetv = 1 Then vtxt = col_ind_text.Z(i) txt_slb = col_slb.Z(n_vetv) txt_sle = col_sle.Z(n_vetv) sta = CLng(col_sta.Z(n_vetv)) x_slb = col_w_x.Z(vtxt) y_slb = col_w_y.Z(vtxt) x_sle = col_w_x.Z(vtxt+1) y_sle = col_w_y.Z(vtxt+1) bang = col_ugol.Z(vtxt) eang = col_ugol.Z(vtxt+1) x1 = d_node.Item(ip).x y1 = d_node.Item(ip).y x2 = d_node.Item(iq).x y2 = d_node.Item(iq).y cvizb = 1 cvize = 3 plb = col_signP.Z(n_vetv) if d_node.Item(ip).col <> -1 Then set newGrouptemp = root.SelectSingleNode("//*[@na='na_"& CStr(d_node.Item(ip).na) &"']") if TypeName(newGrouptemp) <> "Nothing" Then set newGroup = newGrouptemp Else set newGroup = newGroupAllVetv End If Else set newGroup = newGroupAllVetv End if AddLine newGroup, d_node.Item(ip).vh, d_node.Item(iq).vh, Nprb, Npre, aIzg, x1, y1, x2, y2, col_tip.Z(i), col_wid1.Z(i), sta, _ newGrouptxt, txt_slb, txt_sle, x_slb, y_slb, x_sle, y_sle, bang, eang, cvizb, cvize, plb End If End If Next root.setAttribute "viewBox","0 0 "&CStr(width+100)&" "&CStr(height+100) root.appendChild(newGroupAll) root.appendChild(newGroupAllVetv) root.appendChild(newGrouptxt) SVGDoc.save(SaveFile) set SVGDoc = nothing d_node.RemoveAll set d_node = nothing Rastr.Printp "END" End Sub