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
(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)
)
Sub Zoom2Structure(strucName As String)
to be Sub Zoom2Structure()
. 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. '' Add this line
ThisDrawing.SetVariable "USERS1", strucName
AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
USERS1 code,(setq strucname (getvar "USER1"))
"USERS1"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
(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)
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
(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
....
command:.... ; error: bad argument type: stringp nil
Structure "" not found.
from this area lsp
....
(princ (strcat "\nStructure \"" strcname "\" not found.")
....
ThisDrawing.SetVariable "USERS1", strcname
....
Honestly, if I have a text value of 10 in A1. I want to pass that cell value over to the routine. I would assume if A1 had a formula in it, it would take that value and pass it through. I hope I’m answering this right. LolSure, that's doable, but you haven't shown all your code for that part of the task. You just showed ".......". You could set a breakpoint in your xl vba and step through execution to see where it's failing to send the cell value.
Option Explicit
Public Sub PasteCurrentCell()
Dim sh As Excel.Worksheet
Dim rng As Excel.Range
Set sh = GetExcelSheet()
If sh Is Nothing Then
MsgBox "Excel is not running, or" & vbCrLf & _
"opened Excel file does not have ""SHEET1""."
Exit Sub
End If
Set rng = sh.Range("A1") '<<<<<---- How can I make this select the current active cell?? it could be in any column or row.
rng.Copy
InsertCurrentCellValue
End Sub
Private Function GetExcelSheet() As Excel.Worksheet
Dim theSheet As Excel.Worksheet
Dim sh As Excel.Worksheet
Dim xls As Excel.Application
On Error Resume Next
Set xls = GetObject(, "Excel.Application")
If Not xls Is Nothing Then
For Each sh In xls.ActiveWorkbook.Worksheets
If UCase(sh.Name) = "SHEET1" Then
Set xls.ActiveSheet = sh
Set theSheet = sh
Exit For
End If
Next
End If
Set GetExcelSheet = theSheet
End Function
Private Sub InsertCurrentCellValue()
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
ThisDrawing.SetVariable "USERS1", strcname
AcadApp.ActiveDocument.SendCommand "zm2st" & vbCr
End Sub
If Val(acadApp.Version) < 20 Then
Else
acadDoc.SendCommand '''z2S''' acadCmd & vbCr
End If
Sub Commands()
Dim acadApp As Object
Dim acadDoc As Object
Dim acadCmd As String
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Sheet1")
With sht
.Activate
Set Rng = ActiveCell
End With
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If acadApp Is Nothing Then
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True
End If
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
End If
On Error GoTo 0
acadCmd = ""
If Not IsEmpty(ActiveCell.Value) Then
acadCmd = acadCmd & ActiveCell.Value & vbCr
End If
If Val(acadApp.Version) < 20 Then
Else
acadDoc.SendCommand acadCmd & vbCr
End If
End Sub