'Per chi mi volesse aiutare questo è uno script per generare delle frecce soltanto che in output i vertici delle frecce appaiono girati nel verso opposto invece di venire così, ---> mi vengono così, ---< dove può essere l'errore?Spero ci sia qualche anima pia che mi aiuti a superare questo problema vi sarò molto riconoscente grazie mille!!
Function GetAngle (v1 As LineVertex, v2 As LineVertex) As Integer
Dim bx As Integer, by As Integer, x As Double, y As Integer
bx=v2.GetXPosition-v1.GetXPosition
by=v2.GetYPosition-v1.GetYPosition
If bx = 0 Then
GetAngle = 0
Else
x=atn(by/bx)
If x < 0 Then y = 270 Else y = 90
x = x /.0174532925 + y ' conversione radianti --> gradi
getangle = x
End If
End Function
Sub SVGArrow1 (Tipo As String, angolo As Integer, x As Integer, y As Integer)
If aParm.aDebugMode Then Print "angolo: ";angolo, "x: ";x, "y: ";y
Pri 2,"<use xlink:href='#" & lcase(Tipo) & "'"
Pri 2," transform='rotate(" & angolo & "," & x & "," & y & ")"
pri 2,",translate(" & x & "," & y & ")' />"
End Sub
Sub SVGArrow (v As RoseItemView, Tipo As String,ByVal XOffset As Integer, ByVal YOffset As Integer, ByVal Hei As Integer, ByVal Wid As Integer)
Dim vx As LineVertex
Dim alfa As Integer, beta As Integer
Dim i As Integer, x As Integer, y As Integer
If aParm.aDebugMode Then Print " Polyline: "; Tipo
Dim rel As relation
Dim Rol As role
Dim ri As roseitem
Dim Ass As association
Set ri = v.Item
alfa = GetAngle (v.LineVertices.GetAt(1),v.LineVertices.GetAt(2))
i=v.LineVertices.count
beta = getangle (v.LineVertices.GetAt(i-1),v.LineVertices.GetAt(i))
If aParm.adebugmode Then Print "alfa = " & alfa ; " - Beta = " & beta
Select Case Tipo
Case "InheritRelation"
SVGArrow1 Tipo, beta, v.LineVertices.GetAt(i).GetXPosition,v.LineVertice s.GetAt(i).GetYPosition
Case "Association"
Print ri.identifyclass
If ri.cantypecast(Ass) Then
Set Ass = ri.typecast(Ass)
If (Ass.role1.navigable And ass.role2.navigable) Or (Not Ass.role1.navigable And Not ass.role2.navigable) Then
'entrambi i lati navigabili oppure no: nessuna freccia
ElseIf Not Ass.role1.navigable And ass.role2.navigable Then
SVGArrow1 Tipo, alfa, v.LineVertices.GetAt(1).GetXPosition,v.LineVertice s.GetAt(1).GetYPosition
ElseIf Ass.role1.navigable And Not ass.role2.navigable Then
SVGArrow1 Tipo, beta, v.LineVertices.GetAt(i).GetXPosition,v.LineVertice s.GetAt(i).GetYPosition
End If
End If
Case Else
SVGArrow1 Tipo, alfa, v.LineVertices.GetAt(1).GetXPosition,v.LineVertice s.GetAt(1).GetYPosition
SVGArrow1 Tipo, beta, v.LineVertices.GetAt(i).GetXPosition,v.LineVertice s.GetAt(i).GetYPosition
End Select
Pri 2,"<polyline class='" & Tipo & "'"
ind = ind + 1
On Error Resume Next
Pri 2," id='L" & IND & "L" & v.item.GetUniqueID & "'"
On Error GoTo 0
OutColors v
x = XOffset - v.LineVertices.GetAt(1).GetXPosition
y = YOffset - v.LineVertices.GetAt(1).GetYPosition
Pri 2, " points=' "
For i=1 To v.LineVertices.count
Set vx = v.LineVertices.getAt(i)
Pri 2, " " & vx.GetXPosition & "," & vx.GetYPosition
Next
Pri 2, "'"
PriCR 2, " />"
Pri 2, "<g />"