AlasCAD
I hate doing things I can make my computer do for me. My adventures in customizing and automating computers. Primarily with AutoCAD and Microsoft Office.
Wednesday, October 16, 2024
How to do "OR" conditions in Outlook rules
Friday, December 22, 2023
Nested Layer Control Autocad Lisp Routines
Sorry this is a bit rough, I was in a hurry.
Begin NestedLayerControl.lsp
;| c:llo turn a layer off by selecting a nested entity c:llk lock a layer by selecting a nested entity c:llf freeze a layer by selecting a nested entity c:llu unlock a layer by selecting a nested entity c:llp Set layer plotting on by selecting a nested entity c:llnp Set layer plotting off by selecting a nested entity c:vplf ViewPort Layer Freeze by selecting a nested entity nlf nested layer functions ezl:nllist dialog box routine used for nlf |; (defun c:llo ( ;turn a layer off by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf "OFF" T) (princ) ) ;end llo (defun c:llk ( ;lock a layer by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf "LOCK" T) (princ) ) ;end llk (defun c:llnp( ;Turn off plotting by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf '("P" "NoPlot") T) (princ) ) (defun c:llp( ;Turn plotting on by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf '("P" "Plot") T) (princ) ) (defun c:vplf( / ) (nlf "VPLFREEZE" T) (princ) ) (defun c:llf ( ;freeze a layer by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf "FREEZE" T) (princ) ) ;end llf (defun c:llu ( ;unlock a layer by selecting a nested entity / ;no formal arguments ) ;no local variables (nlf "UNLOCK" T) (princ) ) ;end llU (defun nlf ( ;nested layer functions which ;text string for the layer command nestedp ;true to work on nested layers, nil otherwise / ;end of formal argument list blipmode cmdecho echo elist ent layer prmpt temp ) ;end of local variable list (cond ;;linetype change ((and (listp which) (= "L" (strcase (car which)))) (setq prmpt (strcat "change to linetype " (cadr which)) echo (strcat "changed to " (cadr which) " linetype.") ) ) ((and (listp which) (= "P" (strcase (car which)))) (setq prmpt (strcat "set to " (cadr which)) echo (strcat "Set to " (cadr which) ".") ) ) ((listp which) (alert "Unhandled list as argument WHICH in EZLayer nlf function.") ) ((equal "OFF" which) (setq prmpt "turn off:" echo "turned off." ) ;_ end of setq ) ((equal "FREEZE" which) (setq prmpt "freeze:" echo "frozen." ) ;_ end of setq ) ((equal "LOCK" which) (setq prmpt "lock:" echo "locked." ) ;_ end of setq ) ((equal "UNLOCK" which) (setq prmpt "unlock:" echo "unlocked." ) ;_ end of setq ) ((equal "VPLFREEZE" which) (setq prmpt "freeze in current viewport:" echo "frozen in current viewport:" ) ) ((equal "Plot Off" which) (setq prmpt "Turn plotting off:" echo "Plotting turned off: ") ) ((equal "Plot On" which) (setq prmpt "Turn plotting on:" echo "Plotting turned on: ") ) (T exit) ) ;end cond (cond ((and (null nestedp) (setq ent (entsel (strcat "Pick entity on layer to " prmpt))) ) (setq elist (entget (car ent)) layer (cdr (assoc 8 elist)) ) ) ;end null nestedp ((and (setq ent (nentsel (strcat "Pick entity on layer to " prmpt))) (setq temp (ezl:nllist ent)) (/= 0 (car temp)) ) ;end and (setq layer (cadadr temp)) ) (T (alert "\nInvalid value in nlp function.")(exit)) ) ;end nestedp (if (and (= (strcase layer) (getvar "clayer")) (= which "FREEZE") ) (progn (princ "\nSetting current layer to 0. ") (setvar "clayer" "0") ) ) (progn (setq blipmode (getvar "blipmode") cmdecho (getvar "cmdecho") ) ;_ end of setq (setvar "cmdecho" 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "blipmode" 0) (cond ;;linetype ((and (listp which) (member (strcase (car which)) '("L" "P")) ) (command "layer" (car which) (cadr which) layer "") ) ((listp which) (alert "Unhandled list for WHICH argument in nlf function.") ) ;;basic layer command ((member which '("FREEZE" "OFF" "LOCK" "UNLOCK" )) (command "layer" which layer "") ) ;;vplayer freeze ((= which "VPLFREEZE") (if (= 0 (getvar "tilemode")) (command "vplayer" "f" layer "" "") (alert "This command must have tilemode set to 0") ) ) (T (alert (strcat "Invalid function name: " which " in nlf function in ezlutils.lsp"))) ) (setvar "blipmode" blipmode) (setvar "cmdecho" cmdecho) (princ (strcat "\nLayer " layer " " echo)) (setvar "cmdecho" cmdecho) (setvar "blipmode" blipmode) ) ;end progn (princ) ) ;end nlf (defun ezl:nllist ( ;list the layers of a nested entity sellist ;list returned by nentsel / ;end of formal argument list elayer ;nested function nlist:fill_list ;nested function entlist llist dcl_id listitem which ) ;end of local variable list (defun elayer ( ;return the entity type and layer name ent ;entity name / ;end of formal argument list elist layer etype ) ;end of local variable list (setq elist (entget ent) layer (cdr (assoc 8 elist)) etype (cdr (assoc 0 elist)) etype (cond ((= "INSERT" etype) (strcat "Block " (cdr (assoc 2 elist)) " insertion" ) ;_ end of strcat ) ((= "ATTDEF" etype) "Attribute Definition" ) ((= "ATTRIB" etype) "Attribute" ) ((= "BODY" etype) "3D Solid" ) (T etype) ) ;_ end of cond ) ;end setq (list etype layer) ) ;end elayer (defun nllist:fill_list ( ;fill the layers list box llist ;list of layers and entity descriptions listbox-key ;the key for the listbox / ;end of formal argument list ) ;end of local variable list (start_list listbox-key) (foreach ent llist (add_list (strcat (cadr ent) ;layer name "\t " (car ent) ;entity description ) ;end strcat ) ;end add_list ) ;end foreach (end_list) llist ) ;_ end of defun (if (<= 4 (length sellist)) (setq entlist (cons (car sellist) (last sellist))) (setq entlist (list (car sellist))) ) ;_ end of if (setq llist (mapcar 'elayer entlist) dcl_id (load_dialog "nllist.dcl") ) ;_ end of setq (if (not (new_dialog "setlayer" dcl_id)) (exit) ) ;_ end of if (action_tile "layer_list" "(setq listitem $value)") (nllist:fill_list llist "layer_list") (setq listitem (get_tile "layer_list") which (start_dialog) ) ;_ end of setq (done_dialog) (unload_dialog dcl_id) (list which (nth (atoi listitem) llist)) ) ;end ezl:nllist
Begin NLList.dcl
dcl_settings : default_dcl_settings { audit_level = 3; } setlayer : dialog { initial_focus = "layer_list" ; key = "chlayer" ; label = "Select layer" ; : list_box { allow_accept = true ; key = "layer_list" ; label = "Layers" ; mnemonic = "L" ; width = 96 ; height = 32; tabs ="16 24 32"; } ok_cancel ; }
Monday, August 27, 2012
This link to Justify_Text_Tools.lsp (originally by Ryan Pace) has routines for setting the justification of text/mtext objects. The included routines are:
As you can see, each of the routines calls the JustifyText routine with an argument telling it which justification to use. This allows us to use the one core routine for multiple tools so if we ever have to update the routines we only have to update the JustifyText sub-routine.(defun c:JTL () (JustifyText "TL")(princ));Justify Text to top left(defun c:JTR () (JustifyText "TR")(princ));Justify Text to top right(defun c:JTC () (JustifyText "TC")(princ));Justify Text to top center(defun c:JML () (JustifyText "ML")(princ));Justify Text to middle left(defun c:JMR () (JustifyText "MR")(princ));Justify Text to middle right(defun c:JMC () (JustifyText "MC")(princ));Justify Text to middle center(defun c:JBL () (JustifyText "BL")(princ));Justify Text to bottom left(defun c:JBR () (JustifyText "BR")(princ));Justify Text to bottom right(defun c:JBC () (JustifyText "BC")(princ));Justify Text to bottom center
(defun JustifyText(mode / *ERROR* cmdecho)
(defun *ERROR*(msg)
(command)
(command)
(command)
(if cmdecho (setvar "cmdecho" cmdecho))
(princ msg)
)
(setq cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond
((null (setq ss1 (vl-catch-all-apply 'ssget (list '((0 . "Text,Mtext,Attdef"))))))
nil
)
((vl-catch-all-error-p ss1)
(princ (strcat "\nERROR|" (vl-catch-all-error-message ss1)))
nil
)
((and
(= 'PICKSET (type ss1))
(= 0 (sslength ss1))
)
nil
)
(T(command "_justifytext" ss1 "" mode))
)
(setvar "cmdecho" cmdecho)
ss1
)
Thursday, August 23, 2012
EZOffset and leveraging a code snippet to create multiple routines
Since I am emailing tips to my coworkers I thought I would start posting some of the background on those tips.
This is a link to EZOFFSET.LSP which has the following aliases for offsetting specific distances:
(defun ezoffset(and can be called, like this:
dist
/
offsetdist
)
(setq offsetdist (getvar "offsetdist"))
(setvar "offsetdist" dist)
(command "offset" dist)
(while (wcmatch (getvar "cmdnames") "*offset*")
(command pause)
)
(setvar "offsetdist" offsetdist)
(princ)
)
(princ)
)
(defun c:OF1()(ezoffset 0.0625)) ;offset 1/16"
(defun c:OF2()(ezoffset 0.125)) ;offset 2/16" (1/8")
The naming conventions I have used for these routines are arbitrary, but they work for me.
Let me know if you find these useful.
Monday, May 25, 2009
Number base conversion - optimized
This is a second iteration on my previous post.
Seconds for 25,000 Iterations | ||||
Number | Base | ToBase10 | ToBase10-2 | Change |
1111 | 2 | 1.08 | 0.656 | -40% |
1523 | 6 | 1.09 | 0.547 | -50% |
15A23 | 26 | 1.86 | 0.703 | -38% |
Take the above for what it’s worth. If this is a time critical conversion and you have tight control over the number being converted – you may opt for using ToBase10-2 and wrapping it in a vl-catch-all-apply. Either way, it’s your call.
(defun ToBase10-2(NumBase InputValue / )(setq
indx 0
;;Get the list of multipliers
temp (mapcar
(function
(lambda (x)
(if (< 57 x)
(- x 55)
(- x 48)
)
)
)
(reverse (vl-string->list
(if (= 'INT (type InputValue))
(itoa InputValue)
InputValue
)
)
)
)
rtval 0
)
(repeat (length temp)
(setq
digit (nth indx temp)
rtval (+ rtval (* Digit (expt NumBase indx)))
indx (1+ indx)
)
)
rtval
)
Number base conversion
This routine will convert a number from any base between 2 and 36, inclusive, to base 10.
Routine: ToBase10
Purpose: Convert a number from any base between 2 and 36 to base 10
Arguments: NumBase - integer where 2<= NumBase <= 36. The number base from which we are
converting.
InputValue
Symbol - example: '010010
Number - example: 10010
string - example: "010010" or "10010"
Returns: The input value converted to base 10
=============================================================================================
This routine is the inverse of the base routine found in the acad developement help files
under "ASCII Code Conversion", hence, (tobase10 16 (base 16 5284)) returns 5284
---------------------------------------------------------------------------------------------
Example1: (tobase10 2 '11001011 ) returns 203
Example2: (tobase10 2 11001011 ) returns 203
Example3: (tobase10 2 "11001011") returns 203
Example4: (tobase10 6 '15243 ) returns 2475
Example5: (tobase10 6 15243 ) returns 2475
Example6: (tobase10 6 "15243") returns 2475
Example7: (tobase10 16 '34F1A ) returns 216858
Example9: (tobase10 16 "34F1A") returns 216858
Notice that '34F1A cannot be represented as a number, hence, only two examples
Example10: (tobase10 36 '11001011 ) returns 60525828
Example11: (tobase10 36 11001011 ) returns 60525828
Example12: (tobase10 36 "11001011") returns 60525828
As a check, use this online java applet.
(defun ToBase10 (NumBase InputValue / rtval)
;;Here we convert out input value’s type.
(cond
((= 'str (type inputvalue))
(setq inputvalue (strcase inputvalue))
)
((= 'SYM (type inputvalue))
(setq InputValue (vl-symbol-name InputValue))
)
)
;;Here we start validating our input
(cond
;;Base is not an integer
((not (= 'int (type NumBase)))
(strcat
"ERROR|ToBase10 base argument must be an integer - "
(vl-prin1-to-string (type NumBase))
" provided (" (vl-prin1-to-string NumBase) ")"
)
)
;;Base argument is out of range
((or
(> 2 NumBase)
(< 36 NumBase)
)
(strcat
"ERROR|ToBase10 Base argument must be greater than 1 and less than 36 - " (itoa NumBase) " provided."
)
)
;;InputValue is of wrong type for specified base
((and
(> NumBase 10)
(not (= 'STR (type InputValue)))
)
"ERROR|Numbers in a base greater than 10 must be expressed as a string - ToBase routine."
)
;;InputValue has invalid characters
((not (vl-every
(function
(lambda (asciicode)
(cond
;;Character below "0" used
((< asciicode 48) nil)
;;Character greater than valid used for base less than or equal to 10
((and
(<= NumBase 10)
(> asciicode (+ 47 NumBase))
)
nil
)
;;For base greater than 10, invalid character used
((and (> NumBase 10)
(not (wcmatch (chr asciicode) (strcat "[0-9],[A-" (chr (+ NumBase 54)) "]")))
)
nil
)
(T T)
)
)
)
(vl-string->list (if (= 'INT (type InputValue))
(itoa InputValue)
InputValue
)
)
)
)
(strcat
"ERROR|Invalid InputValue argument provided to ToBase10 routine : " (vl-prin1-to-string InputValue)
)
)
;;Now we’re done validating the input, let’s get started
(T
(setq
indx 0
;;Get the list of multipliers
temp (mapcar
(function
(lambda (x)
(if (< 57 x)
(- x 55)
(- x 48)
)
)
)
(reverse (vl-string->list
(if (= 'INT (type InputValue))
(itoa InputValue)
InputValue
)
)
)
)
rtval 0
)
(repeat (length temp)
(setq
digit (nth indx temp)
rtval (+ rtval (* Digit (expt NumBase indx)))
indx (1+ indx)
)
)
rtval
)
)
)
The concept for this approach was derived from here - chapter IX.
Friday, April 24, 2009
Bulk Rename Utility
I am working on a project that involves renaming many xref drawing files. To deal with redirecting all of the references to these files I have created a routine that reads a list of old reference drawing names and new reference drawing names from a tab delimited text file. The lisp routine then renames each reference to each of the redirected files and changes the path to point to the renamed drawing. The intention is that this routine will be run by the s::startup routine when a drawing opens. This allows us to simply add an entry to the redirection list and it will be handled the next time any referencing drawings are opened.
Yesterday I was faced with the task of renaming about 50 of these xref drawing files in one shot. Enter “Bulk Rename Utility”. Bulk Rename Utility is a free file renaming tool allowing you to easily rename files and entire folders based upon extremely flexible criteria. A look at a screenshot (here) gives an idea just how many options there are. This utility not only allowed me to rename these 50 files in one quick shot, but also gave me a tab delimited list of the old name and new name pairs. This list will go directly into my xref redirection list with very little additional tweaking.
Kudos to a great piece of free software. Download it here:http://www.bulkrenameutility.co.uk/Main_Intro.php
Wednesday, April 22, 2009
Get all insertions of a block
Let’s look at a way to get all insertions of a block without using ssget and without iterating through all objects in the drawing. This method will also get nested block insertions.
Let’s say the block we want is named “Test2”.
We can use tblobjname to get the block definition entity, thus:
(tblobjname "block" "test2")This will get us an entity name which we can run through entget to get the following:
((-1 . <Entity name: 7ee414c8>)Here we have the beginning of the block definition – the objects that make up the block. If we do an entget on the entity name at assoc 330, we get something like the following:
(0 . "BLOCK")
(330 . <Entity name: 7ee414c0>)
(5 . "181")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbBlockBegin")
(70 . 0)
(10 0.0 0.0 0.0)
(-2 . <Entity name: 7ee414d0>)
(2 . "test2")
(1 . "")
)
((-1 . <Entity name: 7ee414c0>)Note the 331 entries. These are the entity names for each insertion of Test2.
(0 . "BLOCK_RECORD")
(330 . <Entity name: 7ee3fc08>)
(5 . "180")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbBlockTableRecord")
(2 . "test2")
(360 . <Entity name: 7ee414c8>)
(340 . <Entity name: 0>)
(102 . "{BLKREFS")
(331 . <Entity name: 7ee414e8>)
(331 . <Entity name: 7ee41540>)
(102 . "}")
(70 . 1)
(280 . 1)
(281 . 0)
)
This approach has distinct advantages over ssget, primarily because this will show nested insertions. Also, with a bit of trickery, this can be used with objectdbx documents – avoiding the need to iterate every object in the drawing looking for block insertions.
For more information see my entry on Getting block insertions with objectdbx.