首先得聲明一下：這段代碼基本上是"借"來(lái)的。只是做了些修改。這段代碼的作用是計(jì)算選定區(qū)域的面積，運(yùn)行效果如下面的圖，用了比較多的SendCommand，不太可取，不過(guò)也無(wú)大礙，管用就行。另外，有多次對(duì)Auto-CAD環(huán)境變量的操作，GetVariable/SetVariable，至于各環(huán)境變量有什么用，可以查看CAD幫助文檔。
         修正Bug：重設(shè)ObjectSnapMode之后，原來(lái)的捕捉設(shè)置會(huì)丟失，必須得修改OSMODE環(huán)境變量的值才行。

[程序代碼]   

Public Sub XArea() '選擇一點(diǎn)，計(jì)算圍繞該點(diǎn)的對(duì)象圍成的面積
On Error GoTo ErrorHandler
Dim pt As Variant
Dim spt As String
Dim i As Integer
Dim zarea As Double
zarea = 0
    
'得到當(dāng)前的對(duì)象總數(shù)
Dim oCount As Long
oCount = ThisDrawing.ModelSpace.count
  
'得到當(dāng)前邊界創(chuàng)建的對(duì)象類(lèi)型(0 為面域，1 為多段線(xiàn))
Dim oOL As Integer
oOL = ThisDrawing.GetVariable("HPBOUND")
    
'得到當(dāng)前層的名字
Dim currentLayer As String
currentLayer = ThisDrawing.ActiveLayer.Name
  
'得到當(dāng)前線(xiàn)體的顏色
Dim oColor As String
oColor = ThisDrawing.GetVariable("CECOLOR")
         '－－By :忽又一天 Email:wzw.icy@gmail.com QQ：365052003
'新建一層并把它設(shè)為當(dāng)前層、還原用戶(hù)配置
Dim areaLayer As AcadLayer
Set areaLayer = ThisDrawing.Layers.Add("macula_Area_")
areaLayer.color = 11
ThisDrawing.ActiveLayer = areaLayer
  
'關(guān)閉對(duì)象捕捉
Dim CurSnapMode
CurSnapMode = ThisDrawing.GetVariable("OSMODE")
ThisDrawing.ObjectSnapMode = False
  
'設(shè)置新的線(xiàn)體顏色(這一段可以省去提示用戶(hù)輸入，沒(méi)太大意義，不過(guò)類(lèi)似的寫(xiě)法還是有意義的)
Dim cr As String
cr = ThisDrawing.Utility.GetString(0, vbCrLf & " 選擇顏色[隨層(L)/隨塊(K)/自定義(S)]<隨層>：")
If cr = "k" Or cr = "K" Then
    ThisDrawing.SetVariable "CECOLOR", "0"
ElseIf cr = "s" Or cr = "S" Then
    ThisDrawing.SendCommand "COLOR "
Else
    ThisDrawing.SetVariable "CECOLOR", "256"
End If
  
Dim oName As String
Dim oLayer As String
Dim oNum As Long
  
'計(jì)算單個(gè)區(qū)域的面積并求和
Do While 1
   pt = ThisDrawing.Utility.GetPoint(, vbCrLf & "請(qǐng)選取區(qū)域內(nèi)部任意一點(diǎn)：")
   spt = pt(0) & "," & pt(1)
  
   With ThisDrawing
     '得到新的對(duì)象總數(shù)，用于分析是否建立了面域或多段線(xiàn)
     oNum = ModelSpace.count
    
     '設(shè)置當(dāng)前邊界創(chuàng)建的對(duì)象為面域
     ThisDrawing.SetVariable "HPBOUND", 0
    
     '建立一個(gè)面域
     SendCommand Chr(3) & Chr(3) & "-boundary " & spt & " " & " "
    
     '如果建立面域不成功則建立多段線(xiàn)
     If oNum = ModelSpace.count Then
       ThisDrawing.SetVariable "HPBOUND", 1
       SendCommand Chr(3) & Chr(3) & "-boundary " & spt & " " & " "
     End If
    
     '得到最后一個(gè)對(duì)象的名字
     oName = ModelSpace.Item(ModelSpace.count - 1).ObjectName
    
     '獲取把對(duì)最后一個(gè)對(duì)象所在的層，用于分析最后一個(gè)對(duì)象是否是需要的面域或多段線(xiàn)
     oLayer = ModelSpace.Item(ModelSpace.count - 1).Layer
    
     '由三方面判斷對(duì)象是否建立，如果建立則計(jì)算其面積
     If (oNum < ModelSpace.count) And ((oName = "AcDbRegion") Or (oName = "AcDbPolyline")) And (oLayer = "macula_Area_") Then
       SendCommand "draworder last f "
       SendCommand "area "
       SendCommand "o "
       SendCommand "last "
       zarea = Round(zarea + GetVariable("AREA"), 4)
     End If
   End With
     ThisDrawing.Utility.Prompt vbCrLf & "選定區(qū)域的總面積為： " & zarea & vbCrLf
Loop
 ErrorHandler:
'復(fù)制結(jié)果到剪切板
Set mydataobject = New DataObject
mydataobject.SetText zarea
mydataobject.PutInClipboard
MsgBox "選定區(qū)域的總面積為： " & zarea & "   (mm^2)" & Chr(13) & Chr(13) & "計(jì)算結(jié)果已經(jīng)復(fù)制到剪切板！      ", vbOKOnly, "面積計(jì)算"

'刪除計(jì)算面積產(chǎn)生的對(duì)象和圖層、還原對(duì)象捕捉設(shè)置
Do While oCount < ThisDrawing.ModelSpace.count
    ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.count - 1).Delete
Loop
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(currentLayer)
ThisDrawing.Layers.Item("macula_Area_").Delete
ThisDrawing.SetVariable "CECOLOR", oColor
ThisDrawing.SetVariable "HPBOUND", oOL
ThisDrawing.ObjectSnapMode = True
ThisDrawing.SetVariable "OSMODE", CurSnapMode
SendCommand Chr(3) & Chr(3)
End Sub