明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2850|回复: 3

如何实现AutoCAD里自动布置点的位置

[复制链接]
发表于 2011-10-26 13:24:30 | 显示全部楼层 |阅读模式
AutoCAD VBA 编程是一个初学者,现在正在编辑一个程序,数据库用的是Access,文件名A.MDB,CAD块的文件名B.dwg;块在文件B.dwg已经定义好了,想编辑一个程序把access数据库里对应的”位号坐标“的X/Y坐标撒点到AUTOCAD里,不知道怎么实现,请高手们指点一二,拜谢了!!!
我的编程思路大概是这样:先创建一个选择集程序,设定范围,设定完之后在进行插入块;选择集的程序做好了
Sub Select_Polygon()
Dim SSet As AcadSelectionSet
Dim SSetObj As Object  
On Error Resume Next
Dim fType(0 To 1) As Integer
Dim fData(0 To 1) As Variant
     If Not IsNull(ThisDrawing.SelectionSets.Item("BlockCount")) Then
      Set SSet = ThisDrawing.SelectionSets.Item("BlockCount")
      SSet.Delete
    End If
      Set SSet = ThisDrawing.SelectionSets.Add("BlockCount")
   
fType(0) = 0: fData(0) = "Insert"
fType(1) = 2: fData(1) = "Text_Block"
Dim pT1(0 To 2) As Double
Dim pT2(0 To 2) As Double
Dim Attr_Tag(0 To 1) As String
Dim Attr_Text(0 To 1) As String

Attr_Tag(0) = "A1": Attr_Tag(1) = "B1"
Attr_Text(0) = "Tag_No": Attr_Text(1) = "FT_x01"

pT1(0) = 0: pT1(1) = 0
pT2(0) = 500: pT2(1) = 500

SSet.Select acSelectionSetWindow, pT1, pT2, fType, fData

Dim EntObj As AcadEntity
Dim BlockRefObj As AcadBlockReference
Dim Mtextobj As AcadBlockReference

For Each EntObj In SSet
If TypeOf EntObj Is AcadBlockReference Then
   Set Mtextobj = EntObj
   If Mtextobj.TextString = "Here is title" Then
   Exit For
   Else
   Exit Sub
   End If
End If
Next

Dim AA As String

For Each EntObj In SSet
  If TypeOf EntObj Is AcadBlockReference Then
    Set BlockRefObj = EntObj
         If BlockRefObj.HasAttributes Then
                Attrefs = BlockRefObj.GetAttributes
                For i = 0 To UBound(Attrefs)
                   AA = AA & Attrefs(i).TextString
                   MsgBox AA
                Next
         End If
  End If
Next
   
End Sub
但是下来插入块怎么实现

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2011-10-27 14:29:53 | 显示全部楼层
高手们请帮帮忙啊,请斑竹出招啊
发表于 2011-10-29 19:32:23 | 显示全部楼层
使用EXCEL比较容易实现
发表于 2011-10-30 14:53:40 | 显示全部楼层
VBA很久没玩了,但是这个应该不难吧,打开cad用AcadPoint 对象作为点对象就好了啊。不清楚加我Q
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-23 07:06 , Processed in 0.235856 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表