Sending Cell values to AutoCAD

Code Red > VB(A)

(1/5) > >>

MSTG007:
I am trying to find a way to send a cell value to a activated command at the command line.

Basically, I have a excel file with structure names in Column A1- A20. I want to select the cell of A2 and send that cell value to a lisp routine which is ready to go at the command line with the A2 value.

I am having a dog of a time trying to piece all of this together to work. So the code i have with the Excel Macro is the following:

Excel file is saved as a xlsm. with the References - VBAProject as (AutoCAD 2019 Type Library)

--- Code: ---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
--- End code ---

The following lisp routine which works.

--- Code: ---(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)
)

--- End code ---

Its great when you can reference old posts lol. Here are the two that the examples came from.

http://www.theswamp.org/index.php?topic=55042.0

http://www.theswamp.org/index.php?topic=50025.0

Thank you for any guidance! Again, i have no clue how to make these functions to work together.

n.yuan:
Since your question is about "SEND" value from Excel VBA to a executing LIST of running AutoCAD, started by Acad VBA's "SendCommand" statement, I assume you already know how to get the cell value in the Excel sheet.

This easiest way is to save the value in one of AutoCAD's user system variable (USERI1-5, USERR1-5 or USERS1-5) with the VBA code, and then retrieve the value in the LISP code (which replace the LISP code of asking user for inputting "Structure Name"). In your code, since the cell value is a text value (Structure Name), you would use USERS1, or USERS2...5.

The VBA code change would like:

--- Code - vb.net: ---Sub Zoom2Structure(strucName 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" & vbCrEnd Sub
Then, in your LISP code:

--- Code - Auto/Visual Lisp: ---(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")) ... ... ... ... )

EDIT (John): Added code tags.

MSTG007:
Thank you for your help on this! I just have a few questions if you do not mind. Within the Excel VBA side. I am unable to run the Zoom2Structure macro unless I removed the
--- Code: ---Sub Zoom2Structure(strucName As String)
--- End code ---
to be
--- Code: ---Sub Zoom2Structure()
--- End code ---
. I was then able to select the macro from the menu. It does activate the lisp CAD but it would not push the selected cell value through.

Within the Lisp, does the
--- Code: --- '' Add this line
ThisDrawing.SetVariable "USERS1", strucName
AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
--- End code ---
USERS1 code,

Need to match the
--- Code: ---(setq strucname (getvar "USER1"))
--- End code ---
"USERS1"

Below is the what I currently have setup.

VBA

--- Code: ---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

--- End code ---

LISP

--- Code: ---(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)
--- End code ---

Thanks again for your help! This is definitely cool stuff when it works!

57gmc:
As you found out, a Sub can't accept an argument. Change the sub to a Function. And yes, both pieces of code need to refer to the same variable, "USERS1".

MSTG007:
Could elaborate on that? its not as easy as just changing the sub to function. lol i tried. How would it be activated to run?

Navigation

[0] Message Index

[#] Next page

Go to full version