View Single Post
  #7  
Old 15-04-2007, 22:03
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default


Code:
Sub ChangeLineLenConst()
   const Delta# = -3
   Dim L As Shape, length#, ratio#

   If ActiveShape Is Nothing Then Exit Sub

   ActiveDocument.Unit = cdrMillimeter
   ActiveDocument.ReferencePoint = cdrCenter
   
   Set L = ActiveShape
   length = Sqr(L.SizeWidth ^ 2 + L.SizeHeight ^ 2)
   
   If length + delta > 0 Then
      ratio = (length + delta) / length
      L.SetSize L.SizeWidth * ratio, L.SizeHeight * ratio
   End If
End Sub

Last edited by wOxxOm; 15-04-2007 at 22:24.
Reply With Quote