EXCEL中的AutoCAD标题栏

JGupte · 发表于 2022-7-6 21:44:43

大家好，

我正在尝试编写一个VBA脚本，该脚本将从Excel电子表格中运行，以根据电子表格中的值更新标题栏字段。

我已经能够使用ATTOUT将现有值导出到TXT文件，并使用ATTIN导入更改的值。但我需要从Excel VBA中驱动它。
简单地说，我需要做的是：

循环浏览列表中的所有dwg文件
对于每个dwg文件，
在我的电子表格中找到标题栏值，并将其导出到txt文件（格式正确）
打开dwg文件
导入txt文件（ATTIN）
保存并关闭dwg文件
删除txt文件
环

我相当精通Excel VBA，但不精通AutoCAD。
到目前为止，我可以创建到AutoCAD的链接并打开dwg文件，然后保存并关闭它。

但我不知道如何自动执行ATTIN功能。

由于我不是电脑管理员（公司政策），我无法安装任何工具程序。

任何帮助都将不胜感激。

JG公司

BIGAL · 发表于 2022-7-6 21:50:43

首先，在这里搜索许多标题栏更新的示例。您最好换一种方式，从Autocad中驱动excel。这可以是一个简单的获取单元格并放置atribute。同样，我相信您可以从excel中驱动Autocad。我已经发布了一个vba块属性更新代码，可能是有用的，因为我不确定从excel驱动。基本上有两种方法可以找到要更改的正确属性，即使用其标记名或使用其位置顺序，第二种方法是这里的示例，第一个属性从0开始。请参见attrib（0）

大多数excel/Autocad示例都使用lisp，特别是用Vlisp编写的代码，其方法非常相似。

获取Excel。lsp是我使用的还有其他的，它确实有一些方法可以让excel控制，我从来没有这样做过。

copy


Public Sub ModifyPitSchedule1()
' adds single pt
Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant
'On Error Resume Next
Newpitname = "1"   'dummy to pass then return changed
BLOCK_NAME = "SCHEDTEXT"
pitname = Getpitname(Newpitname)
MsgBox "pitname selected is " & pitname
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"
Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
If SS.Item(Cntr).Name = BLOCK_NAME Then
 
  attribs = SS.Item(Cntr).GetAttributes
       
    If attribs(0).TextString = pitname Then
      pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")
      txtx1 = CStr(FormatNumber(pt1(0), 3))
      TXTY1 = CStr(FormatNumber(pt1(1), 3))
       
       attribs(1).TextString = txtx1
       attribs(2).TextString = TXTY1
       
       attribs(1).Update
       attribs(2).Update
'        ThisDrawing.Application.Update
' try this
       Cntr = SS.Count
    
    Else: End If
     
Else: End If
Next Cntr
ThisDrawing.SelectionSets.Item("pit1sel").Delete
End Sub

获取Excel。拉链

JGupte · 发表于 2022-7-6 21:54:04

嗨，比格尔，
谢谢你的回复。

从Excel而不是AutoCAD驱动此操作的原因是，我们需要在一个Excel电子表格中使用数据更新数千个图形。

我想使用标记名方法，并用电子表格中的值更新现有标记。

例如。
标记名称=“TPDDRAWINGNO”
当前值=“TPDDRAWINGNO”（来自模板）
期望值=“SLR-ALS-D50-CSR-DWG-063201”

这些都将在标题栏中。

该程序将循环浏览电子表格，并适当更新每个图纸。
我将数据放在每个图形的一行中，标记作为列标题。

JG公司

steven-g · 发表于 2022-7-6 21:56:42

你能把你到现在为止的代码贴出来吗。如果有一个工作的起点，帮助别人会更容易。

JGupte · 发表于 2022-7-6 21:58:12

我还没有太多的代码。只是启动AutoCAD并打开图形的基本步骤。

copy

Sub Open_DWG()
   On Error Resume Next
   Dim strDrawing As String
   On Error Resume Next
   Set ACAD = GetObject(, "AutoCAD.Application")
   If Err.Description > vbNullString Then
       Err.Clear
       Set ACAD = CreateObject("AutoCAD.Application")
   End If
   ACAD.Visible = True
   xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update"
   Range("A2").Select
   xDWGFile = ActiveCell & ".dwg"
   xDWGFull = xDWGPath & xDWGFile
   ACAD.Documents.Open (xDWGPath & xDWGFile)
   
   
End Sub

我试图从头开始创建这个项目，并尝试在web上找到的各种代码。

在创建Excel宏时，我通常先录制一个宏来完成我想要的基本任务，然后修改代码以添加循环、错误检查等。

但在AutoCAD中，我不知道如何录制宏（我尝试了动作录制器，但找不到如何编辑生成的代码）。

JG公司

amukul · 发表于 2022-7-6 22:02:56

我想从excel单元格中应用autocad文本命令，如“-text”&交叉！B3&“，-4.5 0距离”
但是我只能从一个单元格中写入一个文本，如何从一个excell文本中从不同位置将多个文本写入autocad

amukul · 发表于 2022-7-6 22:04:04

我想从excel单元格中应用autocad文本命令，如“-text”&交叉！B3&“，-4.5 0距离”
但是我只能从一个单元格中写入一个文本，如何从一个excell文本中从不同位置将多个文本写入autocad。。

例如：
距离（位置4,5）
标高（位置4,7）

请帮助任何人

steven-g · 发表于 2022-7-6 22:08:30

我不能评论这种方式的优点，我不熟悉完整的Autocad，但有兴趣了解如何从Excel发出命令，因此基于您发布的内容，此代码将更新列表中所有图形中的属性。

我使用了-attedit命令，因为这不需要您编写多个txt文件，所以只要一个简单的循环就足够了，我在a列中有图形名称（从A2开始），然后在B列中有旧的属性值，在C列中有新的值，我只在3个简单图形上运行了这个命令，每个图形只有一个布局和属性块，因此没有错误检查或更改为正确的布局，但它奏效了。我建议在运行任何代码之前，对您使用的任何文件夹进行完整备份，并查看有关-attedit命令的帮助文件，以了解如何使用它的布局中可能发生的更改。

copy


Sub Open_DWG()
On Error Resume Next
Dim strDrawing As String
Dim acadCmd As String
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
If Err.Description > vbNullString Then
Err.Clear
Set ACAD = CreateObject("AutoCAD.Application")
End If
ACAD.Visible = True
xDWGPath = "D:\Autodesk support\Drawings"
'xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update"
For x = 2 To 4
Cells(x, 1).Select
xDWGFile = ActiveCell & ".dwg"
xDWGFull = xDWGPath & xDWGFile
ACAD.Documents.Open (xDWGPath & xDWGFile)
acadCmd = "-attedit n n " & vbCr & "TPDRAWINGNO" & vbCr & Cells(x, 2).Value & vbCr & Cells(x, 2).Value & vbCr & Cells(x, 3).Value
ACAD.ActiveDocument.SendCommand acadCmd & vbCr
ACAD.ActiveDocument.SendCommand "qsave close" & vbCr
Next
End Sub