如何在cad中提取所有块的xyz(By Kiseigo)

最新推荐文章于 2023-09-15 20:17:05 发布

nj66666666

最新推荐文章于 2023-09-15 20:17:05 发布

阅读量3.1k

点赞数 2

CC 4.0 BY-SA版权

分类专栏： CAD

本文链接：https://blog.youkuaiyun.com/nj198624/article/details/8160391

CAD 专栏收录该内容

1 篇文章

订阅专栏

本文介绍了一种使用VB宏脚本从损坏的CAD文件中提取块坐标的方法，通过创建选择集并遍历每个块参照，将块的位置信息保存到文本文件中，以便进一步处理和还原。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

如果某个文本或者之类的东西，被恶意的破坏，做成了块，那么我们应该怎么还原呢？

首先，复制所有需要转换的块到一个新的dwg文件，注意：不能存在文字，点，等等！

进入cad中，cad主界面 "工具" - "宏" - "VB编辑器"，以可以Alt + F11 一步到位。

双击左边栏的"ThisDrawing"，然后出现代码输入框，复制下面的代码到框中，然后F5运行D盘就有结果了。

Option Explicit

'功能：提取cad中所有块的x,y,z生成文件在"D:\vbCm.txt", 如“563865.8,2113507.5,-9”格式
'目前功能有限，没有时间完善，以后再说。
'如果提示"选择集已存在"，改动"新建一个选择集"前面的""的内容，如a1改成a2，a2改成a3，直到不再出错
'保证当前cad中，只有块参照，没有其它（点，文字，线）等，否则出错。

PS：如果不是块参照，请在“Call sel1.Select(acSelectionSetAll) '全部选中”设置断点，看到底是什么类型的，改AcadBlockReference成需要的类型就可以了。
Sub allsel()
    Dim sel1 As AcadSelectionSet '定义选择集对象
    Set sel1 = ThisDrawing.SelectionSets.Add("a16") '新建一个选择集
    Call sel1.Select(acSelectionSetAll) '全部选中
    sel1.Highlight (True) '显示选择的对象

    Dim i As Integer
    Dim str As String

    Dim nFileCm As Integer
    nFileCm = FreeFile
    Open "D:\vbCm.txt" For Append As #nFileCm
    Dim strLine As String

    Dim adBlockRef As AcadBlockReference

For Each adBlockRef In sel1
        With adBlockRef
            strLine = adBlockRef.InsertionPoint(0) & "," & adBlockRef.InsertionPoint(1) & "," & adBlockRef.InsertionPoint(2) & vbCr
            Print #nFileCm, strLine
        End With
    Next adBlockRef

    Close #nFileCm

    Set sel1 = Nothing
End Sub