CAD2000中“边界”命令用VBA如何做？

lgf727

CAD2000中“边界”命令用VBA如何到？

efan2000

使用SendCommand来调用内部分命令。

2. 
   
3. Sub test()
   
4.    
   
5.     ' 当前图纸的实体数目
   
6.     Dim n As Long
   
7.     n = ThisDrawing.ModelSpace.Count
   
8.    
   
9.     ' 调用BOUNDARY命令获取某一点处的边界
   
10.     Dim Pt As Variant
    
11.     Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
    
12.     ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
    
13.    
    
14.     ' 如果存在边界，则会生成新的实体
    
15.     Dim lwpLineObj As AcadLWPolyline
    
16.     If ThisDrawing.ModelSpace.Count > n Then
    
17.         Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
    
18.         MsgBox lwpLineObj.Area
    
19.         lwpLineObj.Delete
    
20.     Else
    
21.         MsgBox "未发现有效的边界。"
    
22.     End If
    
23. End Sub
    

<br /> Sub test()<br />     <br />     ' 当前图纸的实体数目<br />     Dim n As Long<br />     n = ThisDrawing.ModelSpace.Count<br />     <br />     ' 调用BOUNDARY命令获取某一点处的边界<br />     Dim Pt As Variant<br />     Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br />     ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr<br />     <br />     ' 如果存在边界，则会生成新的实体<br />     Dim lwpLineObj As AcadLWPolyline<br />     If ThisDrawing.ModelSpace.Count > n Then<br />         Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<br />         MsgBox lwpLineObj.Area<br />         lwpLineObj.Delete<br />     Else<br />         MsgBox "未发现有效的边界。"<br />     End If<br /> End Sub<br />

dchlmz

请教版主，能不能点选之后，实现用某一图层的线得到边界？

alin

BOUNDARY命令前把该层隔离出来

chman

如何获得boundary后形成pline线的折点坐标，谢谢

雪山飞狐_lzh

代码里不是有么？ Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)

lgf727

能否不用SENDCOMMAND方法实现?不知各位有没有什么好办法?我想了好久了一直没解决.