将单元值发送到AutoCAD

mstg007 · 发表于 2021-5-21 09:21:13

我试图找到一种方法，在命令行中向激活的命令发送单元格值。
基本上，我有一个excel文件，在A1列中有结构名称- A20。我想选择A2的单元格，并将该单元格的值发送给一个lisp例程，该例程准备在命令行中使用A2的值。
我花了很长时间试图将所有这些拼凑在一起。所以我的Excel宏代码如下:
Excel文件保存为xlsm。使用References-VBA project as(AutoCAD 2019类型库)

copy

Sub Zoom2Structure()
 On Error Resume Next
 Set AcadApp = GetObject(, "AutoCAD.Application")
 If Err Then
 Err.Clear
 Set AcadApp = CreateObject("AutoCAD.Application")
 End If
 AppActivate AcadApp.Caption
 AcadApp.Visible = True
 AcadApp.Application.WindowState = acNorm
 AcadApp.ActiveSpace = acModelSpace
 If AcadApp.Documents.Count = 0 Then
 AcadApp.Documents.Add
 End If
 AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
End Sub

下面的lisp例程有效。

copy

(defun c:zm2st (/         C3D       C3DDOC    LOCATION  NTWRK
                NTWRKS    PROD      PRODSTR   PT        STRC
                STRCNAME  STRUCTURES
               )
  (vl-load-com)
  (if (setq C3D    (strcat "HKEY_LOCAL_MACHINE\"
                           (if vlax-user-product-key
                             (vlax-user-product-key)
                             (vlax-product-key)
                           )
                   )
            C3D    (vl-registry-read C3D "Release")
            C3D    (substr
                     C3D
                     1
                     (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
                   )
            C3D    (vla-getinterfaceobject
                     (vlax-get-acad-object)
                     (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
                   )
            C3Ddoc (vla-get-activedocument C3D)
      )
    (progn
      (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
      (setq strcname (getstring "\nStructure name to zoom to: " t))
      (vlax-for ntwrk ntwrks
        (if (not strc)
          (progn
            (vl-catch-all-apply
              '(lambda ()
                 (setq structures (vlax-get ntwrk 'structures))
                 (setq strc (vlax-invoke structures 'item strcname))
               )
              '()
            )
          )
        )
      )
      (if strc
        (progn
          (setq location (vlax-get strc 'position))
          (setq pt (list (vlax-get location 'x) (vlax-get location 'y)))
          (command "zoom" "c" pt "40")
        )
        (progn
          (princ (strcat "\nStructure "" strcname "" not found."))
        )
      )
    )
  )
  (princ)
)

当你可以参考旧帖子时，这很棒。这是这两个例子的出处。感谢您的任何指导！同样，我不知道如何让这些功能一起工作。

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

n.yuan · 发表于 2021-5-22 09:23:16

由于您的问题是关于将值从Excel VBA“发送”到正在运行的AutoCAD的执行列表（由Acad VBA的“SendCommand”语句启动），因此我假设您已经知道如何在Excel工作表中获取单元格值
最简单的方法是使用VBA代码将值保存在AutoCAD的一个用户系统变量（USERI1-5、USERR1-5或USERS1-5）中，然后检索LISP代码中的值（该代码取代了要求用户输入“结构名称”的LISP代码）。在代码中，由于单元格值是文本值（结构名称），您将使用USERS1或USERS2…5。
VBA代码更改如下：
子Zoom2结构（strucName作为字符串）
出现错误时，继续下一步
设置AcadApp=GetObject（，即“AutoCAD.Application”）
如果出错，则
错误清除
设置AcadApp=CreateObject（“AutoCAD.Application”）
如果
激活AcadApp.Caption
AcadApp。可见=真
AcadApp.Application。WindowState=acNorm
AcadApp。ActiveSpace=acModelSpace
如果是AcadApp.Documents。计数=0，然后
AcadApp.Documents.Add
如果
添加此行
这张图。SetVariable“USERS1”，strucName
AcadApp.ActiveDocument。SendCommand“zm2st”和vbCr
结束Sub

copy

(defun c:zm2st (/         C3D       C3DDOC    LOCATION  NTWRK
                NTWRKS    PROD      PRODSTR   PT        STRC
                STRCNAME  STRUCTURES
               )
  (vl-load-com)
  (if (setq C3D    (strcat "HKEY_LOCAL_MACHINE\"
                           (if vlax-user-product-key
                             (vlax-user-product-key)
                             (vlax-product-key)
                           )
                   )
            C3D    (vl-registry-read C3D "Release")
            C3D    (substr
                     C3D
                     1
                     (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
                   )
            C3D    (vla-getinterfaceobject
                     (vlax-get-acad-object)
                     (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
                   )
            C3Ddoc (vla-get-activedocument C3D)
      )
    (progn
      (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
 
      ;; Comment this line out
      ;;(setq strcname (getstring "\nStructure name to zoom to: " t))
 
      ;; add this line
      (setq strucname (getvar "USER1"))
      ... ...
      ... ...  
)

编辑（John）：添加代码标记。

mstg007 · 发表于 2021-5-24 13:33:37

谢谢你在这方面的帮助！如果你不介意的话，我只有几个问题。在Excel VBA侧中。除非删除
，否则无法运行Zoom2Structure宏

copy

Sub Zoom2Structure(strucName As String)

成为

copy

Sub Zoom2Structure()

。然后，我可以从菜单中选择宏。它确实激活了lisp CAD，但不会将选定的单元格值推送通过
在Lisp中，
是否

copy

  '' Add this line
 ThisDrawing.SetVariable "USERS1", strucName
 AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr

用户1代码，
需要与
匹配

copy

(setq strucname (getvar "USER1"))

“USERS1”
以下是我目前的设置
VBA

copy

Sub Zoom2Structure(structName As String)
 On Error Resume Next
 Set AcadApp = GetObject(, "AutoCAD.Application")
 If Err Then
 Err.Clear
 Set AcadApp = CreateObject("AutoCAD.Application")
 End If
 AppActivate AcadApp.Caption
 AcadApp.Visible = True
 AcadApp.Application.WindowState = acNorm
 AcadApp.ActiveSpace = acModelSpace
 If AcadApp.Documents.Count = 0 Then
 AcadApp.Documents.Add
 End If
  '' Add this line
 ThisDrawing.SetVariable "USERS1", strucName
 AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
End Sub

LISP

copy

(defun c:zm2st (/         C3D       C3DDOC    LOCATION  NTWRK
                NTWRKS    PROD      PRODSTR   PT        STRC
                STRCNAME  STRUCTURES USERS1
               )
  (vl-load-com)
  (if (setq C3D    (strcat "HKEY_LOCAL_MACHINE\"
                           (if vlax-user-product-key
                             (vlax-user-product-key)
                             (vlax-product-key)
                           )
                   )
            C3D    (vl-registry-read C3D "Release")
            C3D    (substr
                     C3D
                     1
                     (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
                   )
            C3D    (vla-getinterfaceobject
                     (vlax-get-acad-object)
                     (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
                   )
            C3Ddoc (vla-get-activedocument C3D)
      )
    (progn
      (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
      ;;(setq strcname (getstring "\nStructure name to zoom to: " t))
      (setq strucname (getvar "USERS1"))      
      (vlax-for ntwrk ntwrks
        (if (not strc)
          (progn
            (vl-catch-all-apply
              '(lambda ()
                 (setq structures (vlax-get ntwrk 'structures))
                 (setq strc (vlax-invoke structures 'item strcname))
               )
              '()
            )
          )
        )
      )
      (if strc
        (progn
          (setq location (vlax-get strc 'position))
          (setq pt (list (vlax-get location 'x) (vlax-get location 'y)))
          (command "zoom" "c" pt "40")
        )
        (progn
          (princ (strcat "\nStructure "" strcname "" not found."))
        )
      )
    )
  )
  (princ)
)
(C:ZM2ST)

再次感谢您的帮助！这绝对是很酷的东西当它工作！

57gmc · 发表于 2021-5-24 15:27:48

正如你发现的，潜艇不能接受论点。将sub更改为函数。是的，两段代码都需要引用同一个变量“USERS1”。

mstg007 · 发表于 2021-5-24 16:21:29

能详细说明一下吗？这不仅仅是改变接头的功能那么简单。lol我试过了。它将如何被激活运行？

57gmc · 发表于 2021-5-24 17:03:22

是的，只需将关键字Sub改为Function。别忘了结束语。函数不能作为命令直接调用。它必须从公共Sub调用。目的是让Sub中有逻辑来确定函数参数的内容。该结构可以是一个简单的函数：
公共子测试（）
调用MyFunction（“测试字符串”）
末端接头
公共函数MyFunction（str作为字符串）
调试。打印str
结束函数

mstg007 · 发表于 2021-5-25 07:45:00

太棒了。从我所看到的来看，我想我已经有了那部分代码。
这是VBA，我选择A20的单元格值“10”，然后选择功能区中的按钮。它现在激活CAD。

copy

Public Sub Test()
   Call MyFunction("test string")
End Sub
 
Public Function MyFunction(str As String)
    Debug.Print str
End Function
Public Sub Z2S(call as iRibbon)
    Call Z2STR("structName String")
End Sub
Public Function Z2STR(structName As String)
 On Error Resume Next
 Set AcadApp = GetObject(, "AutoCAD.Application")
 If Err Then
 Err.Clear
 Set AcadApp = CreateObject("AutoCAD.Application")
 End If
 AppActivate AcadApp.Caption
 AcadApp.Visible = True
 AcadApp.Application.WindowState = acNorm
 AcadApp.ActiveSpace = acModelSpace
 If AcadApp.Documents.Count = 0 Then
 AcadApp.Documents.Add
 End If
  '' Add this line
 ThisDrawing.SetVariable "USERS1", strucName
 AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
End Function

但是，修改后的代码添加了“USERS1”变量，似乎会在lisp端出错。

copy

(defun c:zm2st (/         C3D       C3DDOC    LOCATION  NTWRK
                NTWRKS    PROD      PRODSTR   PT        STRC
                STRCNAME  STRUCTURES USERS1
               )
....
      (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
      ;;(setq strcname (getstring "\nStructure name to zoom to: " t))
      (setq strucname (getvar "USERS1"))      
      (vlax-for ntwrk ntwrks
....

copy

command:.... ; error: bad argument type: stringp nil

越来越近lol。

57gmc · 发表于 2021-5-25 10:30:15

哈哈。很棒的收获。我更改了“strcname”，因此它们在lsp和vba中都是相同的。
我能够执行命令，现在我得到以下内容：

copy

Structure "" not found.
from this area lsp
....
(princ (strcat "\nStructure "" strcname "" not found.")

在VBA中，哪段代码要求将选择复制到内存中的单元格？
这可能是我错过的最后一步吗？

copy

....
ThisDrawing.SetVariable "USERS1", strcname
....

mstg007 · 发表于 2021-5-25 12:02:08

我不知道您在Excel方面做了什么。您必须确保传递的是有效字符串。您的Z2S sub无效。sub不能有参数，而且您也不能在sub中使用参数。

57gmc · 发表于 2021-5-25 16:26:44

老实说，如果A1中的文本值为10，我想将该单元格值传递给例程。我假设，如果A1中有一个公式，它会取这个值并通过它。我希望我的回答是正确的。英雄联盟

将单元值发送到AutoCAD

发表回复

精选推荐