PDA

View Full Version : Autocad VBA Macro for AutoFlange & Default SpecChoice



Colby
04-04-2006, 05:42 AM
Below is home brewed code to toggle the AutoFlange & Default Spec Choice fields for AutoPlant

If you have not used VBA for AutoCAD then please download the Tutorial provided by this site.

first create a Module and a userform

in the module put the following code.

Sub Main()
'
UserForm1.Show False
End Sub

****** Make sure to put false at the end of show to disable modal dialog boxes.*********


On the Gui part of the form put two buttons

like this


c:\\appref.bmp


In the Userform Code Paste this



'
' Some Variables
'
Private AFOn As String
Private DEFOn As String
Private Sub CommandButton1_Click()

ThisDrawing.SendCommand "(setq $aa(at_pipingsystem_getvariable ""AutoMateFlag""))" & vbCr
ThisDrawing.SendCommand "(setq $file (open ""c:\\AF.txt"" ""w""))" & vbCr
ThisDrawing.SendCommand "(write-line $aa $file)" & vbCr
ThisDrawing.SendCommand "(close $file)" & vbCr
'
Open "C:\af.txt" For Input As #1
Input #1, AFOn
Close #1
'
Kill ("c:\af.txt")
'
If AFOn = "0" Then
CommandButton1.BackColor = &HFF00&
CommandButton1.Caption = "AutoFlange Is ON!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""AutoMateFlag"" ""1"")" & vbCr
Else
CommandButton1.BackColor = &HFF&
CommandButton1.Caption = "AutoFlange Is OFF!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""AutoMateFlag"" ""0"")" & vbCr
End If
End Sub


Private Sub CommandButton2_Click()
ThisDrawing.SendCommand "(setq $bb(at_pipingsystem_getvariable ""SPEC_DEFAULTS_FLAG""))" & vbCr
ThisDrawing.SendCommand "(setq $file (open ""c:\\SDF.txt"" ""w""))" & vbCr
ThisDrawing.SendCommand "(write-line $bb $file)" & vbCr
ThisDrawing.SendCommand "(close $file)" & vbCr
'
Open "C:\SDF.txt" For Input As #1
Input #1, DEFOn
Close #1
'
Kill ("c:\SDF.txt")
'
If DEFOn = "0" Then
CommandButton2.BackColor = &HFF00&
CommandButton2.Caption = "Default Spec Choice Is ON!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""SPEC_DEFAULTS_FLAG"" ""1"")" & vbCr
Else
CommandButton2.BackColor = &HFF&
CommandButton2.Caption = "Default Spec Choice Is OFF!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""SPEC_DEFAULTS_FLAG"" ""0"")" & vbCr
End If
End Sub


Private Sub UserForm_Initialize()
ThisDrawing.SendCommand "(setq $aa(at_pipingsystem_getvariable ""AutoMateFlag""))" & vbCr
ThisDrawing.SendCommand "(setq $file (open ""c:\\AF.txt"" ""w""))" & vbCr
ThisDrawing.SendCommand "(write-line $aa $file)" & vbCr
ThisDrawing.SendCommand "(close $file)" & vbCr
'
Open "C:\af.txt" For Input As #1
Input #1, AFOn
Close #1
'
Kill ("c:\af.txt")
'
If AFOn = "1" Then
CommandButton1.BackColor = &HFF00&
CommandButton1.Caption = "AutoFlange Is ON!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""AutoMateFlag"" ""1"")" & vbCr
Else
CommandButton1.BackColor = &HFF&
CommandButton1.Caption = "AutoFlange Is OFF!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""AutoMateFlag"" ""0"")" & vbCr
End If
'
ThisDrawing.SendCommand "(setq $bb(at_pipingsystem_getvariable ""SPEC_DEFAULTS_FLAG""))" & vbCr
ThisDrawing.SendCommand "(setq $file (open ""c:\\SDF.txt"" ""w""))" & vbCr
ThisDrawing.SendCommand "(write-line $aa $file)" & vbCr
ThisDrawing.SendCommand "(close $file)" & vbCr
'
Open "C:\SDF.txt" For Input As #1
Input #1, DEFOn
Close #1
'
Kill ("c:\SDF.txt")
'
If DEFOn = "1" Then
CommandButton2.BackColor = &HFF00&
CommandButton2.Caption = "Default Spec Choice Is ON!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""SPEC_DEFAULTS_FLAG"" ""1"")" & vbCr
Else
CommandButton2.BackColor = &HFF&
CommandButton2.Caption = "Default Spec Choice Is OFF!"
'
ThisDrawing.SendCommand "(at_pipingsystem_setvariable ""SPEC_DEFAULTS_FLAG"" ""0"")" & vbCr
End If
End Sub


This code uses the AutoCAD sendcommand object to retrieve autoplant System Varaiable's. I know that there is a better way to do this. :twisted: :twisted:

This has worked with version 3.00 & 3.10


happy coding

dave
04-04-2006, 12:12 PM
great one! Thanks for the code Colby!