Convert a 2D shape into 1D

[Yacine]

Hi, I'm trying to use code to convert a 2D shape into a 1D one.
The task seems to not be trivial.
The OneD property of a shape is read-only.
There seems to be no ready implemented conversion function.
And if you record a macro, you'll find some easily transcriptable formulas, but also some nasty values that are not obvious to understand.

Code Select Expand

Sub Makro3()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Verhaltenseigenschaften")
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).AddRow visSectionObject, visRowXForm1D, visTagDefault
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "(BeginX+EndX)/2"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "(BeginY+EndY)/2"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "SQRT((EndX-BeginX)^2+(EndY-BeginY)^2)"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "8.9595528352192 mm"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*1"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU = "ATAN2(EndY-BeginY,EndX-BeginX)"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginX).FormulaU = "108.28670487724 mm"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginY).FormulaU = "52.342722456402 mm"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXForm1D, vis1DEndX).FormulaU = "108.44425698439 mm"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowXForm1D, vis1DEndY).FormulaU = "22.800000684843 mm"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionObject, visRowMisc, visLOFlags).FormulaForceU = "4"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 1, 0).FormulaU = "Width*0"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 1, 1).FormulaU = "Height*1"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 2, 0).FormulaU = "Width*1"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 2, 1).FormulaU = "Height*1"
    Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 2, 6).FormulaForceU = "NURBS(1.3484719020419, 3, 0, 0, 0.12806154393966,-0.19567054007826,0,1, 1.0782610084968,-0.4709961265884,0,1)"
    Application.EndUndoScope UndoScopeID1, True

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub


I wonder whether I should try to do the math by myself or find a workaround.
Any ideas?

[Surrogate]

Hi, Yacine !

Code Select Expand

Application.ActiveWindow.Page.Shapes.ItemFromID(428).CellsSRC(visSectionFirstComponent, 2, 6).FormulaForceU = "NURBS(1.3484719020419, 3, 0, 0, 0.12806154393966,-0.19567054007826,0,1, 1.0782610084968,-0.4709961265884,0,1)"

IMHO because this shape is not trivial 
Something like this ?

[Yacine]

Chrome translated the page for me, but I did not get your point. The vsd from Nikolay has no macros.

[Nikolay]

I was wondering why this fish (?) looked somewhat familiar
Probably this was an example of a shape which is hard to qualify as 1d or 2d.

[Yacine]

Yes, you had a nice chat in russian, but it looked liked it was more of whether a shape is 1 or 2 D.
Transforming a 1D shape into 2D is quite easy by using the join function.
Why on hell did they (M$) not provide the inverse function? (Specially as the recorded macro does it already quite well. The process steps are known. It is just a matter of putting a name on the procedure!)

[Yacine]

Since my 2D shape is generated from a 1D one, I may as best transform the 1D shape into a group and draw in it (instead of drawing to activepage).
This would let me keep the 1D properties of the parent shape.
Absolutely not elegant, but if nothing else helps ... at the end of the day we are known for being highly efficient (=lazy ).


This is not to say the race is over, I can think of many other examples where this function would be useful.

[Surrogate]

but I did not get your point

Nikolay is right, this picture just as example of complex shape. As I understand your code this shape contain few geometry sections and one of them is NURBs. That's why I cited the picture from ancient russian discussion thread, I didn't expect that someone would follow the link hidden under the picture