I'm having trouble with very simple piece of code.
What I'm trying to achieve is to edit lines lenght in Sketch in SolidWorks.
I saw that working in tutorial, but it doesn't work for me.
I'm getting error
Object variable or With block variable not set
I can't really see what's the problem, since everything seems properly defined to me.
Screenshot from solid
Code:
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.AddConfiguration3 "test", Empty, Empty, 0
Dim swDim As SldWorks.Dimension
Set swDim = swModel.Parameter("D1.#Szkic1")
**swDim.SetSystemValue3 0.005, swThisConfiguration, Empty (THIS LINE GETS HIGHLIGHTED)**
swModel.ForceRebuild3 True
End Sub
It might be : "D1#Szkic1" instead of "D1.#Szkic1"
To be sure, you can add the following line after "Set swDim":
If swDim Is Nothing Then MsgBox "Error Selecting Dimension"
Related
I have found a macro for solidworks that works for an individual part, but I will have to (an the rest of the office) will have to change the name taken by the cut list bodies each time.
is there a way to take the file name from the part (we work in multibody parts) and apply it to the cutlist bodies +1 fo each consecutive body?
As mentioned before this macro renames the bodies, it would be absolutely stellar if it took the name from the part file name as this is in accordance with our standard.
code:
Dim swApp As Object
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim vBodyArr As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
swModel.ClearSelection2 True
vBodyArr = swPart.GetBodies2(0, False)
RenameBodies swModel, vBodyArr
End Sub
Sub RenameBodies(swModel As SldWorks.ModelDoc2, vBodyArr As Variant)
Dim vBody As Variant
Dim swBody As SldWorks.Body2
Dim prefixName As String
Dim bodycount As Integer
bodycount = 1
If IsEmpty(vBodyArr) Then Exit Sub
prefixName = "Set swCustPropMgr = TheModel.Extension.CustomPropertyManager"
For Each vBody In vBodyArr
vBody.Name = prefixName & bodycount
bodycount = bodycount + 1
Next vBody
swModel.EditRebuild3
End Sub
I don't know if you already solved your problem, but others might need this too.
You can use
prefixName = swModel.GetPathName
I tested your code and all works well on SolidWorks 2017. It should work on later versions also.
You will probably want to get rid of the full path and extension of the file. Here is a link on stackoverflow showing how to do it:
how to remove path and extension
I'm currently working on developing a macro that will input various forms into an access database.
Due to the nature of the beast of this program, I've had to split my main program into two sub programs and call them, but I need to use getobject to call a file path twice now.
I use getobject to open a file, and then use myrec.fields(~column name~) = xlsht.cells(1, "a") to populate various column values. I'm unsure if there are other "efficient" ways to accomplish this.
I was wondering if it is possible to use a variable in place of the filepath with the GetObject command, instead of needing to manually replace the file path in the code.
I've tested a fair amount of different code, including the path, class functionality but I don't think I understand VBA enough to truly make the best use of that.
I can make it work using this
Dim XL As Variant
Dim XLApp As Variant
Dim XLsht As Variant
Dim XLwrkbk As Variant
Set XL = CreateObject("Excel.Application")
Set XLwrkbk = GetObject(~file path~)
Set XLsht = XLwrkbk.Worksheets(1)
Set MyRec = CurrentDb.OpenRecordset("database name")
Ideally I would like it to be
Dim filename As String
Dim XL As Variant
Dim XLApp As Variant
Dim XLsht As Variant
Dim XLwrkbk As Variant
filename = " ~insert file path~ "
Set XL = CreateObject("Excel.Application")
Set XLwrkbk = GetObject(filename)
Set XLsht = XLwrkbk.Worksheets(1)
Set MyRec = CurrentDb.OpenRecordset("database name")
I receive a run time error
Run-time error '5':
Invalid procedure call or argument.
Try something like this:
Dim XL As New Excel.Application, Filename As String
Filename = "~ your file ~"
XL.Workbooks.Open (Filename)
myrec.fields(~column name~) = XL.Worksheets(1).Range("A1").value
Hi I'm working on a code that will convert imperial values to metric. But I'm having trouble getting my code to work, it always gives me an error on the first line. See code below:
Sub DrawingViewScale()
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oView As DrawingView
Set oView = oDoc.ActiveSheet.DrawingViews.Item(1)
MsgBox oView.scale()
oView.[scale] = 25.4
MsgBox oView.scale()
End Sub
You should declare oDoc like this
Dim oDoc As AcadDocument
That is the answer for question about
error on the first line
But in this code are many more problems
this is an example sub to programatically install a type library for API. Why is the error handling routine failing? I attempted to follow the try...except...finally strategy I am familiar with from Python.
Sub CopyViewLayout():
'TRY:
On Error GoTo addReference
Dim App As femap.model
'COMPILE ERROR: USER TYPE NOT DEFINED
ResumeSub:
Dim App As femap.model
Set App = GetObject(, "femap.model")
Dim rc As Variant
Dim feView As femap.View
Set feView = App.feView
rc = feView.Get(0)
Exit Sub
'EXCEPT:
addReference:
Dim vbaEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim checkRef As VBIDE.Reference
Dim filepath As String
Set vbaEditor = Application.VBE
Set vbProj = ActiveWorkbook.VBProject
filepath = "C:\apps\FEMAPv11\"
On Error GoTo Failure
vbProj.References.AddFromFile (filepath & "femap.tlb")
Set vbProj = Nothing
Set vbaEditor = Nothing
GoTo ResumeSub
'FINALLY
Failure:
MsgBox ("couldn't find type library, exiting sub")
End Sub
EDIT
I broke out this section from main because Error handling is just ridiculous in VBA... A better approach for me was to implement a finite-state-machine using Booleans.
answer
Sub refcheck()
Dim i As Long
Dim FEMAP_GUID As String
FEMAP_GUID = "{08F336B3-E668-11D4-9441-001083FFF11C}"
With ActiveWorkbook.VBProject.references
For i = 1 To .Count
If .Item(i).GUID = FEMAP_GUID Then
Exit For
Else
'note: filepath is determined using Dir() elsewhere...
.AddFromFile (filepath & "femap.tlb")
Exit For
End If
Next
End With
End Sub
Error handling only handles runtime errors; not compile time errors. Use
Dim App as Object
And make sure you only Dim App once in your code.
By using As Object, you can late bind any object to it. You lose Intellisense while youre coding thought.
Like Dick mentioned, use Late Binding but that alone is not enough. You will have to use it with proper Error Handling.
For example
Dim App As Object
On Error Resume Next
Set App = GetObject(, "femap.model")
On Error GoTo 0
If App Is Nothing Then
MsgBox "Please check if femap is installed"
Exit Sub
End If
'
'~~> Rest of the code
'
If you are sure that it is installed then you are getting the error because the relevant library is not referenced. For that I would recommend having a look at How to add a reference programmatically
I would however still suggest that you take the Late Binding route.
Can we read scripts or lines of code to a module in vba? Like we have the include function in php.
For example:
We store this in Excel somewhere and call the range as xyz
line 1 of code
line 2 of code
line 3 of code
Then while running a macro we call this like
Sub my_macro()
xyz
End Sub
Basically I want to run a few lines of code repetitively but don't want to create another macro and pass the parameters.
This can be done using the Microsoft Visual Basic for Applications Extensibility 5.3 (VBIDE) library. There's some great examples at CPearson.com. I typically use this to insert snippets of code while I'm developing. I would personally be uncomfortable executing code stored in an excel sheet, but I tested this and it does work.
My worksheet:
A
1 MsgBox "I'm a test."
2 MsgBox "So am I."
I set up an empty subroutine that we will then insert into from the excel sheet.
Private Sub ProcToModify()
End Sub
And the subroutine that will actually insert the code into ProcToModify:
Sub ModifyProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1") ' specify module to modify
Set CodeMod = VBComp.CodeModule
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set ws = ThisWorkbook.ActiveSheet 'change this accordingly
Set rng = ws.Range("A1:A2") 'and this
For Each cell In rng
ProcName = "ProcToModify"
With CodeMod
StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
.InsertLines StartLine + NumLines - 2, cell.Value 'insert each line at the end of the procedure to get them in the correct order.
End With
Next cell
End Sub
Called at runtime like this:
Public Sub main()
ModifyProcedure
ProcToModify
End Sub
One Big Gotchya:
Before running this code, you need to go to Excel>>File>>Options>>Trust Center>>Trust Center Settings>>Macro Settings and check the "Trust access to the VBA project object model".
I would imagine that's because allowing access to the project object is a fairly concerning security risk.
From the cpearson.com site I linked to earlier:
CAUTION: Many VBA-based computer viruses propagate themselves by
creating and/or modifying VBA code. Therefore, many virus scanners may
automatically and without warning or confirmation delete modules that
reference the VBProject object, causing a permanent and irretrievable
loss of code. Consult the documentation for your anti-virus software
for details.