关于图形属性，向各路大神求教~

︶ㄣ乐高高

1.     For Each obj In ThisDrawing.ModelSpace
   
2.                    Select Case obj.ObjectName
   
3.              Case "AcDbLine":
   
4.                 rst.Open "SELECT id FROM line", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
   
5.                 pt1 = obj.StartPoint
   
6.                 pt2 = obj.EndPoint
   
7.                
   
8.                 If Not FindObj(rst, obj.ObjectID) Then      ' 新建的直线的处理
   
9.                     cmd.CommandText = "INSERT INTO line(id,X1,Y1,X2,Y2) VALUES(" & _
   
10.                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & pt2(0) & "," & pt2(1) & ");"
    
11.                 Else                                        ' 修改的直线的处理
    
12.                     cmd.CommandText = "UPDATE line SET X1=" & pt1(0) & ",Y1=" & pt1(1) & ",X2=" & _
    
13.                         pt2(0) & ",Y2=" & pt2(1) & " WHERE id='" & obj.ObjectID & "';"
    
14.                 End If
    
15.                
    
16.                 cmd.Execute
    
17.                 rst.Close
    
18.             Case "AcDbCircle":
    
19.                 rst.Open "SELECT id FROM circle", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
20.                 pt1 = obj.Center
    
21.                
    
22.                 If Not FindObj(rst, obj.ObjectID) Then
    
23.                     cmd.CommandText = "INSERT INTO circle(id,CenX,CenY,Rad) VALUES(" & _
    
24.                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & ");"
    
25.                 Else
    
26.                     cmd.CommandText = "UPDATE circle SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _
    
27.                         ",Rad=" & obj.Radius & " WHERE id='" & obj.ObjectID & "';"
    
28.                 End If
    
29.                
    
30.                 cmd.Execute
    
31.                 rst.Close
    
32.             Case "AcDbArc":
    
33.                 rst.Open "SELECT id FROM arc", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
34.                 pt1 = obj.Center
    
35.                
    
36.                 If Not FindObj(rst, obj.ObjectID) Then
    
37.                     cmd.CommandText = "INSERT INTO arc(id,CenX,CenY,Rad,StartAng,EndAng) VALUES(" & _
    
38.                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & "," & _
    
39.                         obj.StartAngle & "," & obj.EndAngle & ");"
    
40.                 Else
    
41.                     cmd.CommandText = "UPDATE arc SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _
    
42.                         ",Rad=" & obj.Radius & ",StartAng=" & obj.StartAngle & ",EndAng=" & _
    
43.                         obj.EndAngle & " WHERE id='" & obj.ObjectID & "';"
    
44.                 End If
    
45.                
    
46.                 cmd.Execute
    
47.                 rst.Close

    For Each obj In ThisDrawing.ModelSpace<br />                    Select Case obj.ObjectName<br />              Case "AcDbLine":<br />                 rst.Open "SELECT id FROM line", cn, adOpenForwardOnly, adLockReadOnly, adCmdText<br />                 pt1 = obj.StartPoint<br />                 pt2 = obj.EndPoint<br />                 <br />                 If Not FindObj(rst, obj.ObjectID) Then      ' 新建的直线的处理<br />                     cmd.CommandText = "INSERT INTO line(id,X1,Y1,X2,Y2) VALUES(" & _<br />                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & pt2(0) & "," & pt2(1) & ");"<br />                 Else                                        ' 修改的直线的处理<br />                     cmd.CommandText = "UPDATE line SET X1=" & pt1(0) & ",Y1=" & pt1(1) & ",X2=" & _<br />                         pt2(0) & ",Y2=" & pt2(1) & " WHERE id='" & obj.ObjectID & "';"<br />                 End If<br />                 <br />                 cmd.Execute<br />                 rst.Close<br />             Case "AcDbCircle":<br />                 rst.Open "SELECT id FROM circle", cn, adOpenForwardOnly, adLockReadOnly, adCmdText<br />                 pt1 = obj.Center<br />                 <br />                 If Not FindObj(rst, obj.ObjectID) Then<br />                     cmd.CommandText = "INSERT INTO circle(id,CenX,CenY,Rad) VALUES(" & _<br />                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & ");"<br />                 Else<br />                     cmd.CommandText = "UPDATE circle SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _<br />                         ",Rad=" & obj.Radius & " WHERE id='" & obj.ObjectID & "';"<br />                 End If<br />                 <br />                 cmd.Execute<br />                 rst.Close<br />             Case "AcDbArc":<br />                 rst.Open "SELECT id FROM arc", cn, adOpenForwardOnly, adLockReadOnly, adCmdText<br />                 pt1 = obj.Center<br />                 <br />                 If Not FindObj(rst, obj.ObjectID) Then<br />                     cmd.CommandText = "INSERT INTO arc(id,CenX,CenY,Rad,StartAng,EndAng) VALUES(" & _<br />                         "'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & "," & _<br />                         obj.StartAngle & "," & obj.EndAngle & ");"<br />                 Else<br />                     cmd.CommandText = "UPDATE arc SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _<br />                         ",Rad=" & obj.Radius & ",StartAng=" & obj.StartAngle & ",EndAng=" & _<br />                         obj.EndAngle & " WHERE id='" & obj.ObjectID & "';"<br />                 End If<br />                 <br />                 cmd.Execute<br />                 rst.Close

例如上面代码。。。我想知道多边形、椭圆 的obj.ObjectName？还有如何确定他们位置，例如圆是用X,Y坐标和obj.Radius 就能描述出来呢，那多边形、椭圆呢 用什么 确定位置 obj.什么和obj.什么？？最好有个跟我上面代码类似的。。。小弟初学VBA，求各路大神帮助，多谢

sscylh

矩形,多边形,pline的objectname都是lwpolyline,椭圆是ellipse,可以通过lisp的(entget (car (entsel)))查看,组码为0的是也!

markc0826

ObjectID在64位元系统会产生错误讯息，建议改由Handle来纪录图元资讯...