【原】绘制多边形程序的终篇

我们前面是通过对话框绘制折线的，需要知道折线顶点坐标，往往不太方便。我们今天再来编写一个程序，预想的功能是，在幻灯片页面里选中几个图形对象，根据这些图形对象的中心点来决定所要画的折线顶点，只要单击一个按钮，就可以立即执行。

一、程序内容

Public Sub DrawPoly()
    Dim arr() As Single, n As Integer

    n=ActiveWindow.Selection. ShapeRange.Count
    If n < 3 Then
      MsgBox "所选对象少于三个"
      Exit Sub
    End If
    If MsgBox("你是否要创建多边形？", _
       vbYesNo, "绘制图形")= vbYes Then
       With ActiveWindow.Selection.ShapeRange(1)
           ReDim arr(1 To n + 1, 0 To 1)
           arr(n + 1, 0) = .Left + .Width / 2
           arr(n + 1, 1) = .Top + .Height / 2
           End With
       Else
       ReDim arr(1 To n, 0 To 1)
    End If
    i = 1
    For i = 1 To n
       With ActiveWindow.Selection.ShapeRange(i)
           arr(i, 0) = .Left + .Width / 2
           arr(i, 1) = .Top + .Height / 2
       End With
    Next

ActiveWindow.View.Slide.Shapes.AddPolyline SafeArrayOfPoints:=arr
End Sub

二、需要解释的地方

先介绍几个对象和属性。

ActiveWindow-当前打开的窗口

Selection-全体选中对象

ShapeRange-其中的图形对象

Count-数目

以上用点号依次连接起来，意思就是：当前打开窗口中的全体选中对象中图形对象的数目。

程序用变量 n 来表示所选对象的数目，用变量而非属性值可以加快程序的运行，特别是在多次需要用到同一个属性值的时候。这里要判断选中对象的多少，少于三个将退出程序。

接下来弹出对话框询问使用者是否要绘制多边形？如果用户单击“是”（对话框返回 vbYes），则数组长度要比选择图形的数目多一，并且最后一个点的坐标和第一个点的坐标一致，否则的话只让数组长度和所选图形数目相同就可以。

再往下就是用循环语句进行其它点的赋值，还有画图。

选点顺序不同，画出的图形不同

这个程序用到了全部三种程序结构——顺序、分支和循环。

我们学了这个程序以后，可以举一反三，比如选中幻灯片里的三个图形对象，然后绘制过这三个图形对象中心点的圆形，或者选中幻灯片里的两个图形对象，以第一个图形的中心点为圆心，两个图形中心点之间的距离为半径作圆，等等。这样我们就可以开发出属于自己的绘图功能。

那么，这个程序有什么作用呢？仅仅是作者为了展示一段程序吗？其实不是。大家可以想一下，我们可以把本程序中用来标志多边形顶点的各个图形对象（完全可以是一个个的小圆点）在几何画板里画好，再复制到 PowerPoint 里去，经过适当的“取消组合”等操作把各个点独立出来后，再用这个程序绘制多边形。这样我们就可以让几何画板和 PowerPoint 实现强强联合。

三、还差点什么

差点什么呢？和 PowerPoint 自带的功能相比，我们的程序必须通过功能区的“开发工具/宏”按钮或者 VBA 环境中的运行按钮来执行，这是美中不足之处。我本来是想实现这个功能的，但是在我身边几台不同的电脑上运行，效果都不一致，各有各的问题。用我以前编写的程序进行试验，时好时不好的，看来这已经属于玄学领域了。我试着从网上找解答，没有答案。所以这里要对支持我的朋友们说声对不起了。希望大家从我这些内容中还能得到一点收益，不是完全浪费时间。