AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Utils (33 Kb)

Utils is a selection of Utility Functions written in VBA for use in Autocad Rel 14.
It consists of 3 Files :

CHL.DVB--Change Layer
CHLT.DVB-Change Linetype
CHC.DVB--Change Color

Along with them I have Included UTIL.LSP and UTIL.MNU
These 2 files provide the link between Autocad and VBA by providing a Toolbar to select a routine and a lisp file that loads and runs the routine.
I have provided these files mainly to show what can be done using VBA and Autocad.

P.S.
Please ensure that all files are in a directory called c:\utils and that this directory is in you Autocad search Path.

Change Layer

Source Code For Chl.Dvb 

Dim ss As IAcadSelectionSet
Option Explicit
    
Private Sub CommandButton1_Click()
Dim Entity As Object
Me.Hide
Set ss = ThisDrawing.SelectionSets.Add("NEWSS")
ss.SelectOnScreen
For Each Entity In ss
    Entity.Layer = lstLayers.Text
Next
Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub


Private Sub lstLayers_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Entity As Object
Me.Hide
Set ss = ThisDrawing.SelectionSets.Add("NEWSS")
ss.SelectOnScreen
For Each Entity In ss
    Entity.Layer = lstLayers.Text
Next
Unload Me
End Sub

Private Sub UserForm_Activate()
Dim AcadApp As Object
Dim AllLayers As Object
Dim Layer As Object

Set AcadApp = GetObject(, "AutoCAD.Application")
Set AllLayers = AcadApp.ActiveDocument.Layers
For Each Layer In AllLayers
    lstLayers.AddItem Layer.Name
    Next
End Sub

Source Code For Utils.Lsp 

(prompt "\nPlease Wait...CadKen VBA Utilities Loading...")
(defun c:chl ()
 (setvar "filedia" 0)                         ; disable all file dialog boxes
 (command "_VBALOAD" "c:\\UTILS\\chl.dvb")    ; load the VBA routine
 (setvar "filedia" 1)                         ; enable all file dialog boxes
 (command "_-VBARUN" "module1.ChangeLayer")   ; run the defined macro
 (princ)				      ; finish clean
 )                                            ; c:chl
(defun c:chlt ()
 (setvar "filedia" 0)                         
 (command "_VBALOAD" "c:\\UTILS\\chlt.dvb")   
 (setvar "filedia" 1)                         
 (command "_-VBARUN" "module1.ChangeLineType")
 (princ)				      
 )                                            
(defun c:chc ()
 (setvar "filedia" 0)                         
 (command "_VBALOAD" "c:\\UTILS\\chc.dvb")    
 (setvar "filedia" 1)                         
 (command "_-VBARUN" "module1.ChangeColor")   
 (princ)				      
 )                                            
(princ)

Source Code For Utils.Mnu 

***MENUGROUP=UTILS

***TOOLBARS
**UTILITIES
TB_Utility [_Toolbar("Utilities", _Floating, _Show, 0, 0, 1)]
TB_ChLayer [_Button("Change Layer", "chl.bmp", "ICON_32_BLANK")]^C^C^P+
(cond ((null C:UTILS) (prompt "Please Wait...")(load "UTILS"))) CHL
TB_ChLType [_Button("Change Line Type", "chlt.bmp", "ICON_32_BLANK")]^C^C^P+
(cond ((null C:UTILS) (prompt "Please Wait...")(load "UTILS"))) CHLT
TB_ChColor [_Button("Change Color", "chc.bmp", "ICON_32_BLANK")]^C^C^P+
(cond ((null C:UTILS) (prompt "Please Wait...")(load "UTILS"))) CHC
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website