René Nyffenegger's collection of things on the web
René Nyffenegger on Oracle - Most wanted - Feedback -
 

Get points of line [Excel macro]

Sub get_points_of_line()

  dim sh_f     as shape
  dim sh_t     as shape
  dim nd       as shapenode
  dim pt       as variant
  dim pt_first as variant
  dim r        as integer

  dim delta_x  as double
  dim delta_y  as double

  dim first    as boolean
  dim second   as boolean


  set sh_f = activesheet.shapes.addline(50.0, 100.0, 200.0, 400.0)

  sh_f.Nodes.SetSegmentType 1, msoSegmentCurve

  sh_f.Nodes.Insert 1, msoSegmentCurve, msoEditingAuto, 70.0,  70.0
  
  set sh_f = activesheet.shapes(1)

  ' -- done drawing, start copying

  first  = true
  second = false

  r = 1

  delta_x = 139
  delta_y = 87

  for each nd in sh_f.nodes

      if first then
         pt_first = nd.points
         first    = false
         second   = true
      else
         pt = nd.points

         if second then
            second = false

            set sh_t = activesheet.shapes.addline ( _
               pt_first(1,1) + delta_x,            _
               pt_first(1,2) + delta_y,            _ 
               pt      (1,1) + delta_x,            _ 
               pt      (1,2) + delta_y             _
            )

         else
         ' msgbox("-----------")
         ' msgbox(pt(1,1) & "," & pt(1,2))

            sh_t.Nodes.Insert r,                 _
                              msoSegmentLine,    _
                              msoEditingAuto,    _
                              pt(1,1) + delta_x, _ 
                              pt(1,2) + delta_y

            r=r+1
         end if
      end if
      
  next nd
  
End Sub