关于图形属性，向各路大神求教~
For Each obj In ThisDrawing.ModelSpaceSelect Case obj.ObjectName
Case "AcDbLine":
rst.Open "SELECT id FROM line", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
pt1 = obj.StartPoint
pt2 = obj.EndPoint
If Not FindObj(rst, obj.ObjectID) Then ' 新建的直线的处理
cmd.CommandText = "INSERT INTO line(id,X1,Y1,X2,Y2) VALUES(" & _
"'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & pt2(0) & "," & pt2(1) & ");"
Else ' 修改的直线的处理
cmd.CommandText = "UPDATE line SET X1=" & pt1(0) & ",Y1=" & pt1(1) & ",X2=" & _
pt2(0) & ",Y2=" & pt2(1) & " WHERE id='" & obj.ObjectID & "';"
End If
cmd.Execute
rst.Close
Case "AcDbCircle":
rst.Open "SELECT id FROM circle", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
pt1 = obj.Center
If Not FindObj(rst, obj.ObjectID) Then
cmd.CommandText = "INSERT INTO circle(id,CenX,CenY,Rad) VALUES(" & _
"'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & ");"
Else
cmd.CommandText = "UPDATE circle SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _
",Rad=" & obj.Radius & " WHERE id='" & obj.ObjectID & "';"
End If
cmd.Execute
rst.Close
Case "AcDbArc":
rst.Open "SELECT id FROM arc", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
pt1 = obj.Center
If Not FindObj(rst, obj.ObjectID) Then
cmd.CommandText = "INSERT INTO arc(id,CenX,CenY,Rad,StartAng,EndAng) VALUES(" & _
"'" & obj.ObjectID & "'," & pt1(0) & "," & pt1(1) & "," & obj.Radius & "," & _
obj.StartAngle & "," & obj.EndAngle & ");"
Else
cmd.CommandText = "UPDATE arc SET CenX=" & pt1(0) & ",CenY=" & pt1(1) & _
",Rad=" & obj.Radius & ",StartAng=" & obj.StartAngle & ",EndAng=" & _
obj.EndAngle & " WHERE id='" & obj.ObjectID & "';"
End If
cmd.Execute
rst.Close
例如上面代码。。。我想知道多边形、椭圆 的obj.ObjectName？还有如何确定他们位置，例如圆是用X,Y坐标和obj.Radius 就能描述出来呢，那多边形、椭圆呢 用什么 确定位置 obj.什么和obj.什么？？最好有个跟我上面代码类似的。。。小弟初学VBA，求各路大神帮助，多谢
矩形,多边形,pline的objectname都是lwpolyline,椭圆是ellipse,可以通过lisp的(entget (car (entsel)))查看,组码为0的是也! ObjectID在64位元系统会产生错误讯息，建议改由Handle来纪录图元资讯...
页:
[1]