View Single Post
Old 05-02-2008, 15:47
Posts: n/a
Default Create Rectangle-Shape with positioning

Hi Everybody
I'm looking for a solution for the following Problem:
I have documents with different kinds of rectangles and text. What I want to do is to get the position and the size of each of these rectangles and create a new Rectangle with exact the same position and size but with other line properties and then delete the first rectangle.
What I have is:
Sub typ()
Dim shp As Shape
Dim shpneu As Shape
Dim pos As String
Dim styp As Byte
Dim sel As ShapeRange
Dim hoch As Double, breit As Double, posh As Double, posl As Double
For Each shp In ActivePage.Shapes
If shp.Type = 3 Then
hoch = shp.SizeHeight
breit = shp.SizeWidth
posh = shp.PositionX
posl = shp.PositionY
Set shp = ActiveLayer.CreateRectangle(posl, posh, (posl + breit), (posh + hoch))
shp.Outline.SetProperties 0.003
End If
Next shp
End Sub
This creates a new Rectangle with the right size but the Position is different and I don't understand why?
Anybody out there who has an Idea??
Reply With Quote