Leaderboard

Thank you for your support Steven! I searched everywhere for weeks on end with all the associated frustrations. The explanation behind your code suddenly gave me a push and saw the light burn

no, I don't know grread well, I have tried it today but am not getting anything I am happy with yet. Also I am gong to look at Lee Macs IncarrayD - think somewhere on his website there is a description of what he does to make objects visible as you copy or move them - which is what I was trying to do here I'll try your suggestion later or over the weekend. NIce Leika, glad it is working for you

As far as I know I got out, definitely not perfect but got the base I wanted. With the code you all show here I can build in and embellish many options with OpenDCL. Thank you very much ! ;;; =================================================================================================== ;;; All Credits to Joe Burke - 3/2/2003 ;;; Modified by Leika Marchal 10/06/2022 ;;; Increment first number found in text or mtext object ;;; Other characters may precede number, "A-2" +2 returns "A-4" ;;; Works with reals and integers ;;; Options: increment copy multiple or increment existing text ;;; Cancel or Return to end ;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715 ;;; =================================================================================================== (defun c:IncrementText (/ *Error* Inc Ent Obj OldStr Mode NewStr OldNum Lst Res bpt nxpt) (defun *Error* (Msg) (cond ((or (not Msg) (member Msg '("console break" "Function cancelled" "quit / exit abort"))) ) (princ (strcat "\nError: " Msg)) ) (setvar "cmdecho" 1) (princ) ) (vl-load-com) ;by Michael Puckett ;retain characters contained in pattern within string (defun wcfilter ( string pattern / i c result ) (setq result "" i 0) (repeat (strlen string) (if (wcmatch (setq c (substr string (setq i (1+ i)) 1)) pattern ) (setq result (strcat result c)) ) ) result ) (setvar "cmdecho" 0) (defun PickTest () (setq Obj (entsel "\nSelect text to increment or Cancel to end: ")) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget (car Obj))))) (/= "TEXT" (cdr (assoc 0 (entget (car Obj))))) ) ) (setq Obj (entsel "\nText object not selected - try again: ")) ) ) (setq Inc (read (getstring "\nEnter increment value positive or negative: "))) (initget "Y N") ; Force User Input with (initget 1 "Y N ") (prompt "\n| ") (prompt "\n| Yes, will copy and add or subtract multiple times") (prompt "\n| No, will add or subtract existing text ") (prompt "\n| ") (prompt "\n| ") (princ) (setq Mode (getkword "\nCopy text [Yes/No] : ")) (if (= Mode "N") (progn (prompt "\n| ") (prompt "\n| ") (prompt "\n| ") (prompt "\n| Existing text will be edit ") (prompt "\n| ") (princ) (while (setq Obj (entsel "\nSelect text to edit <exit> : ")) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget (car Obj))))) (/= "TEXT" (cdr (assoc 0 (entget (car Obj))))) ) ) (setq Obj (entsel "\nText object not selected - try again: ")) ) (setq Ent (car Obj)) (setq Lst (entget Ent)) (setq OldStr (cdr (assoc 1 (entget Ent)))) (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) (if (numberp OldNum) (progn (setq Res (+ Inc OldNum) Res (vl-princ-to-string Res) OldNum (vl-princ-to-string OldNum) NewStr (vl-string-subst Res OldNum OldStr 0) Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst) ) (entmod Lst) (entupd Ent) ) (princ "\nNumber not found in text object ") ) ) ) ) (if (= Mode "Y") (progn (PickTest) (setvar "lastpoint" (setq bpt (getpoint "\nBase point :"))) (while (setq nxpt (getpoint "\nEnter next point <exit> :" )) (if (null Ent) (progn (setq Ent (car Obj)) (command ".copy" Ent "" bpt nxpt) (setq Ent (entlast)) ) (progn (command ".copy" (entlast) "" (getvar "lastpoint") nxpt) (setq Ent (entlast)) ) ) (setq Lst (entget Ent)) (setq OldStr (cdr (assoc 1 (entget Ent)))) (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) (if (numberp OldNum) (progn (setq Res (+ Inc OldNum) Res (vl-princ-to-string Res) OldNum (vl-princ-to-string OldNum) NewStr (vl-string-subst Res OldNum OldStr 0) Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst) ) (entmod Lst) (entupd Ent) ) (princ "\nNumber not found in text object ") ) ) ) ) (*Error* nil) (setvar "cmdecho" 1) (princ) ) ;shortcut ;(defun c:IT () (c:IncrementText)) (c:IncrementText)

.,, If you know all the user names and email addresses..... which might mean a lot of updating in a company with staff changes? If I am reading this right then if Outlook is running you can get the current users e-mail address? Working off line and you can't? The e-mail domain indicates the company the user works for and so the data to put into the drawing. Using Tombus idea of a database of user names, I think this could be created dynamically, little user interaction. If and when the user is working in CAD, and is online with outlook could you copy their e-mail address to a separate text file, create a bit of a database that way. Each time a users opens up CAD, check their details in the text file, if not there check outlook, if outlook isn't online give them a pop-up to ask, then write those details to the text file? Saved centrally for all users or locally for a single user in the windows temps folder or somewhere, Might be you could include name (from Wndows user name), their e-mail, the company they work for, and perhaps a last checked (for tidying up the database depends how big it gets, delete anyone who hasn't signed in within 18 months (allowing for maternity leave you see))

I use the attached lisp to set the Author in a drawings property to the name they prefer derived from their "USERNAME" assigned in Windows using the macro ^C^C^P(load "Author.lsp")(Author). You could modify it to derive the email associated from their "USERNAME" if you know all their usernames and email addresses. Author.lsp

Also to link to someones documents folder (strcat (getenv "userprofile") "\\Documents\\")

Not directly but you can easily get their username with (getenv "USERNAME"). For most offices the rest of their email addresses are the same and could easily be added on. I use it in code to both add the users name to a drawing and to add a link to open their network folder.

I don't have to do anything and it takes 1ms to generate.

; IB - 2022.06.10 exceed ; https://www.cadtutor.net/forum/topic/75382-use-lisp-to-create-block-and-autoselect-objects-with-ssget/ ; ; make block with instant name. example is all circle (defun C:IB ( / ss oldcmd box midpt ) (setq oldcmd (getvar 'cmdecho)) (if (= oldcmd 1) (setvar 'cmdecho 0)) (if (setq ss (ssget "_X" '((0 . "CIRCLE")))) (progn (setq box (LM:ssboundingbox ss)) (setq midpt (list (/ (+ (car (car box)) (car (cadr box))) 2) (/ (+ (cadr (car box)) (cadr (cadr box))) 2))) (command "_.COPYBASE" midpt ss "") (command "_.ERASE" ss "") (command "_.PASTEBLOCK" midpt) (princ "\n IB - complete") ) (progn (princ "\n IB - there's no object for making block") ) ) (setvar 'cmdecho oldcmd) (princ) ) (vl-load-com) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; sel - [sel] Selection set for which to return bounding box (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) ) add function for center point as base point how about this?

Thought of that too but you end up with blocks like this.

; IB - 2022.06.10 exceed ; https://www.cadtutor.net/forum/topic/75382-use-lisp-to-create-block-and-autoselect-objects-with-ssget/ ; ; make block with instant name. example is all circle (defun C:IB ( / ss oldcmd ) (setq oldcmd (getvar 'cmdecho)) (if (= oldcmd 1) (setvar 'cmdecho 0)) (if (setq ss (ssget "_X" '((0 . "CIRCLE")))) (progn (command "_.COPYBASE" "0,0" ss "") (command "_.ERASE" ss "") (command "_.PASTEBLOCK" "0,0") (princ "\n IB - complete") ) (progn (princ "\n IB - there's no object for making block") ) ) (setvar 'cmdecho oldcmd) (princ) ) how about this? this is the method using that ctrl+shift+v. It might be easier to leave it to the "command" than to generate a serial number for the name.

@mhupp That Set_BlkName code seems a bit overkill when you could do something as simple as this (defun _blockname (prefix / i r) (setq i 0) (while (tblobjname "BLOCK" (setq r (strcat prefix "_" (itoa (setq i (1+ i))))))) r ) (_blockname (getenv "USERNAME")) Or if you want to tie the date to the name: (defun _blockname (prefix / r) (while (tblobjname "BLOCK" (setq r (strcat prefix "_" (menucmd "M=$(edtime, $(getvar,date),YYYY-MO-DD.MM)"))) ) ) r ) (_blockname (getenv "USERNAME"))

I thought I had it there for a moment, but not quite.... See below, and perhaps someone can point me in the right direction later. This isn't finished yet, it will need things like the cmdecho turning off temporarily and the error stopping, little tidying up. This will work, copy mtext and text as required. The base point will move with the text which I thought was useful. I have used a few of the parts from your example and of course refer to that. My problem is the copy loop and how to exit it, at the moment the copy loop will end on escape or with a right mouse click (as requested), problem is that it won't now exit with a space bar or an enter... does anyone know how to force a loop to finish if an enter or space is pressed within it? Or to detect if a space or enter was pressed during the last command (Looked briefly at grread, that might work), thanks See the code below, highlighted in ';;;;;;;;;;;;' what I a meaning (defun c:inctext ( / myent lstpt nxtpt) ;;;; Sub routines ;;;; (defun *Error* (Msg) (cond ((or (not Msg) (member Msg '("console break" "Function cancelled" "quit / exit abort")))) ((princ (strcat "\nError: " Msg))) ) (setvar "cmdecho" 1) (princ) ) (defun wcfilter ( string pattern / i c result ) (setq result "" i 0) (repeat (strlen string) (if (wcmatch (setq c (substr string (setq i (1+ i)) 1)) pattern) (setq result (strcat result c)) ) ) result ) (defun numbinc (myent Inc / NewNum ) (setq Lst (entget myent)) (setq OldStr (cdr (assoc 1 (entget myent)))) (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) ;;check if a number (if (numberp OldNum) (progn (setq Res (+ Inc OldNum)) (setq Res (vl-princ-to-string Res)) (setq OldNum (vl-princ-to-string OldNum)) (setq NewStr (vl-string-subst Res OldNum OldStr 0)) ;;Number increased (setq Lst (entget myent)) ;;entget new text (setq Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst)) ;;substitute in new number (up to 250 characters) (entmod Lst) ;;modify (entupd myent) ;;update ) ;end progn (princ "\nNumber not found in text object ") ) ;end if ) ;;; End Sub;;;; (setq Inc 1) (if (setq myss (ssget "_+.:E:S" '((0 . "*TEXT"))) ) ;;c/o Lee Mac tutorials, if: just ends if no text, while: gives another chance (progn (setq myent (ssname myss 0)) (setq lastpt (cdr (assoc 10 (entget myent)))) ;;get old base point (command ".copy" myent "" (setq nxtp (getpoint)) pause) ;;first copy. (setq myent (entlast)) ;; Get new text (numbinc myent Inc) ;; increase new text '+Inc' (setq newpt (cdr (assoc 10 (entget myent)))) ;;get new base point (setq mydsp (list (- (nth 0 newpt)(nth 0 lastpt))(- (nth 1 newpt)(nth 1 lastpt))(- (nth 2 newpt)(nth 2 lastpt)))) (setq nxtp (list (+ (nth 0 nxtp)(nth 0 mydsp))(+ (nth 1 nxtp)(nth 1 mydsp))(+ (nth 2 nxtp)(nth 2 mydsp)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (while (< 1 acount) ;;Infinite loop - don't like it ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq lastpt (cdr (assoc 10 (entget myent)))) ;;get old base point (command ".copy" myent "" nxtp pause ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; add here cancel if space or enter pressed ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq myent (entlast)) ;; Get new text (numbinc myent Inc) ;; increase new text '+Inc' (setq newpt (cdr (assoc 10 (entget myent)))) ;;get new base point (setq mydsp (list (- (nth 0 newpt)(nth 0 lastpt))(- (nth 1 newpt)(nth 1 lastpt))(- (nth 2 newpt)(nth 2 lastpt)))) (setq nxtp (list (+ (nth 0 nxtp)(nth 0 mydsp))(+ (nth 1 nxtp)(nth 1 mydsp))(+ (nth 2 nxtp)(nth 2 mydsp)))) );end while );;end progn (princ "Text not selected") );end if (princ) )

While manually selecting items to be in a block is sometimes slow. I would advice against using ssget "_X" when making block selections. it takes most of the control away from you. Yes you can filter it down but do you want all circles in the drawing to be in this one block? This is a stripped down version of my quick block lisp. run command and promoted to name block. if you either try to name it an already existing block name or leave the name blank it will auto generate a random name like "$J34K4-2V0489". Same with the base point you can either pick it or just right click and it will be in the middle of selected entity's. ;;----------------------------------------------------------------------------;; ;; Quick Block - Creates Block from selected objects (defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR) (if (setq SS (ssget)) (progn (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil)) (Set_blkname) ) (if (not (setq MPT (getpoint "\nSpecify Base Point: "))) (progn (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt) (setq ptslst (cons (vlax-safearray->list minpt) ptslst) ptslst (cons (vlax-safearray->list maxpt) ptslst) ) ) (setq LL (apply 'mapcar (cons 'min ptslst)) UR (apply 'mapcar (cons 'max ptslst)) MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2)) ) ) ) (vl-cmdf "_.Block" blkname "_non" MPT SS "") (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0) (prompt (strcat "\nBlock [" blkname "] Was Created.")) ) (prompt "\nNothing Selected") ) (princ) ) ;;;======================================================================== ;;; ;;; *** AUTO-BLOCK.LSP *** ;;; BLOCK CREATION ON THE FLY : "Just select your objects" ;;; ;;; By Raymond RIZKALLAH, October/2004 ;;;======================================================================== (defun Set_BlkName () (setq o-dmzn (getvar "dimzin")) (setvar "dimzin" 0) (setq c-date (getvar "cdate")) (setq w-all (rtos c-date 2 20)) ;; >> "20041022.11423489" (setq w-yr (substr w-all 3 2)) ;; ["01" to "99"] >> "04" (setq w-mn (substr w-all 5 2) ;; ["A" to "L"] >> "J" w-mn (chr (+ 64 (read w-mn))) ;; ) (setq w-dy (substr w-all 7 2)) ;; ["A" to "Z" + "1" to "5"] >> "V" (if (<= (read w-dy) 26) ;; (setq w-dy (chr (+ 64 (read w-dy)))) ;; (setq w-dy (rtos (- (read w-dy) 26) 2 0)) ;; ) (setq w-hr (substr w-all 10 2) ;; ["A" to "S"] >> "K" w-hr (chr (+ 64 (read w-hr))) ;; ) (setq w-mt (strcat (substr w-all 12 1) "-" (substr w-all 13 1))) ;; ["00" to "59"] >> "4-2" (setq w-sc (substr w-all 14 2)) ;; ["00" to "59"] >> "34" (setq w-mm (substr w-all 16 2)) ;; ["00" to "59"] >> "89" (setq blkname (strcat "$" w-mn w-sc w-hr w-mt w-dy w-yr w-mm)) ;; >> "$J34K4-2V0489" (setvar "dimzin" o-dmzn) (princ) )

You could try the system variable SNAPUNIT, and set it to 2.5,2.5

(defun c:SYSINFO ( / getiplist iplist ipv6list driveindex drivetxt noofdrive drivesr) ;https://www.theswamp.org/index.php?topic=42276.0 (defun getip ( / WMI CSERV EXQ gip) (vl-load-com) (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) (setq CSERV (VLAX-INVOKE WMI 'ConnectServer "." "\\root\\cimv2" nil nil nil nil nil nil)) (setq EXQ (vlax-invoke CSERV 'ExecQuery "Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = true")) (vlax-for item EXQ (setq gip (vlax-get item 'IPAddress)) ) (vlax-release-object wmi) (vlax-release-object CSERV) (vlax-release-object EXQ) gip ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540967 (defun Get_BaseBoardSerialNumber (/ LocatorObj ServiceObj ObjectSetObj SerialNumber) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "Select * from Win32_BaseBoard" ) ) (vlax-for Obj ObjectSetObj (setq SerialNumber (vlax-get Obj 'SerialNumber) ) ) (foreach Obj (list LocatorObj ServiceObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) SerialNumber ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540992 (defun Get_ProcessorId (/ LocatorObj SecurityObj SecurityObj ObjectSetObj Processor_Id ) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "Select * from Win32_Processor" ) ) (vlax-for Obj ObjectSetObj (setq Processor_Id (vlax-get Obj 'ProcessorId) ) ) (foreach Obj (list LocatorObj ServiceObj SecurityObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) Processor_Id ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540993 (defun Get_UUID (/ LocatorObj ServiceObj ObjectSetObj UUID) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "SELECT UUID FROM Win32_ComputerSystemProduct" ) ) (vlax-for Obj ObjectSetObj (setq UUID (vlax-get Obj 'UUID) ) ) (foreach Obj (list LocatorObj ServiceObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) UUID ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540994 (defun SerialInfo_BIOS (/ WMI meth1 meth2 serial) (vl-load-com) (cond ((and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) (setq meth1 (vlax-invoke WMI 'ConnectServer nil nil nil nil nil nil nil nil)) (setq meth2 (vlax-invoke meth1 'ExecQuery (strcat "Select * from Win32_" "BIOS"))) (vlax-for itm (vlax-get (vlax-invoke meth2 'ItemIndex 0) 'Properties_) (if (eq (vlax-get itm 'name) "SerialNumber") (setq serial (vlax-get itm 'value))))))) (mapcar 'vlax-release-object (list meth1 meth2 wmi)) serial) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540995 (defun get_macaddress (/ Locator Server Query ret) (if (and (setq Locator (vlax-create-object "WbemScripting.SWbemLocator")) (setq Server (vlax-invoke Locator 'ConnectServer "." "root\\cimv2")) (setq Query (vlax-invoke Server 'ExecQuery "select * from Win32_NetworkAdapterConfiguration where IPEnabled = True"))) (vlax-for item Query (setq ret (vlax-get item 'MacAddress)))) (foreach obj (list Locator Server Query) (vl-catch-all-apply 'vlax-release-object (list obj))) ret) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=79829 ;;; * ;;; PART OF 'ASMILIB' LIBRUARY * ;;; Created: 07.10.2007 * ;;; Last modyfied: 07.10.2007 * ;;; ⓒ Alexanders Smirnovs (ASMI) * ;;; * ;;; ********************************* ;;; **** PC Hardware Functions ****** ;;; ********************************* ;;; * ;;; Retrieves Hard Drive serial number * ;;; * ;;; Arguments: * ;;; Path - Path of Hard Drive, for example "C:" (string) * ;;; * ;;; Output: * ;;; Hard Drive serial number (integer) or NIL in case of error. * ;;; * (defun #Asmi_Get_Drive_Serial (Path / fsObj hSn abPth cDrv) (vl-load-com) (if (and (setq fsObj(vlax-create-object "Scripting.FileSystemObject")) (not (vl-catch-all-error-p (setq abPth(vl-catch-all-apply 'vlax-invoke-method (list fsObj 'GetAbsolutePathName Path)) ); end setq ); end vl-catch-all-error-p ); end not ); end and (progn (setq cDrv(vlax-invoke-method fsObj 'GetDrive (vlax-invoke-method fsObj 'GetDriveName abPth ); end vlax-invoke-method );end vlax-invoke-method ); end setq (if (vl-catch-all-error-p (setq hSn(vl-catch-all-apply 'vlax-get-property (list cDrv 'SerialNumber)))) (progn (vlax-release-object cDrv) (setq hSn nil) ); end progn ); end if (vlax-release-object fsObj) ); end progn ); end if hSn ); end of #Asmi_Get_Drive_Serial ;https://www.theswamp.org/index.php?topic=44425.0 (defun _ping (address / out ws) (if (setq ws (vlax-get-or-create-object "WScript.Shell")) (progn (setq out (vlax-invoke ws 'run (strcat "ping.exe -n 1 " address) 0 :vlax-true)) (and ws (vlax-release-object ws)) (zerop out) ) ) ) (if (_ping "google.com") (setq internetping "Yes") (setq internetping "No")) (setq getiplist (getip)) (setq iplist (LM:str->lst (vl-princ-to-string (car getiplist)) " ")) (setq ipv6list (LM:str->lst (vl-princ-to-string (cadr getiplist)) " ")) ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hard-drive-number-in-lisp/m-p/902962/highlight/true#M128620 (defun vl-finddrive (/ DriveList) (foreach Item '("Z" "X" "Y" "V" "W" "U" "T" "S" "R" "Q" "P" "O" "N" "M" "L" "K" "J" "I" "H" "G" "F" "E" "D" "C" "B" "A") (if (= (vl-file-size (strcat Item ":/")) 0.0) (setq DriveList (cons (strcat Item ":/") DriveList)) );end if );end foreach DriveList );end vl-finddrive ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/m-p/2874070/highlight/true#M293991 (defun STD-NUM->HEX (i / s a) (setq s "") (while (> i 0) (setq a (rem i 16) i (lsh i -4) ) ;_ setq (setq s (strcat (if (< a 10) (chr (+ 48 a)) ; 48: (ascii "0") (chr (+ 55 a)) ) ;_ if s ) ;_ strcat ) ;_ setq ) ;_ while ) ;_ defun ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-to-string/m-p/830687/highlight/true#M56345 (defun strlcat (delim lst) (apply 'strcat (cons (substr (car lst) 1 1) (mapcar '(lambda (x) (strcat delim (substr x 1 1)) ) (cdr lst) ) ) ) ) (setq noofdrive (length (vl-finddrive))) (setq drivetxt "") (setq driveindex 0) (repeat noofdrive (setq drivesr (strcat (substr (setq sn (dos_serialno (nth driveindex (vl-finddrive)) )) 1 4) "-" (substr (setq sn (dos_serialno (nth driveindex (vl-finddrive)) )) 5 4))) (setq drivetxt (strcat drivetxt "\n " (substr (nth driveindex (vl-finddrive)) 1 1) " Drive Serial = " (vl-princ-to-string drivesr) )) (setq driveindex (+ driveindex 1)) ) ;(princ drivetxt) (setq infomsg (strcat " Internet Connection = " (vl-princ-to-string internetping) "\n IP = " (vl-princ-to-string (caddr iplist)) "\n IPv6 = " (vl-princ-to-string (caddr ipv6list)) "\n Log-on Server = " (vl-princ-to-string (getenv "LOGONSERVER")) "\n Computer Name = " (vl-princ-to-string (getenv "COMPUTERNAME")) "\n User Name = " (vl-princ-to-string (getenv "USERNAME")) "\n MainBoard Serial = " (vl-princ-to-string (get_baseboardSerialNumber)) "\n Processor ID = " (vl-princ-to-string (Get_ProcessorId)) "\n UUID = " (vl-princ-to-string (Get_UUID)) "\n BIOS Serial = " (vl-princ-to-string (SerialInfo_BIOS)) "\n MAC Address = " (vl-princ-to-string (get_macaddress)) "\n Connected Drive = " (vl-princ-to-string (strlcat ", " (vl-finddrive))) drivetxt ) ) (princ infomsg) ;; Popup - Lee Mac ;; A wrapper for the WSH popup method to display a message box prompting the user. ;; ttl - [str] Text to be displayed in the pop-up title bar ;; msg - [str] Text content of the message box ;; bit - [int] Bit-coded integer indicating icon & button appearance ;; Returns: [int] Integer indicating the button pressed to exit (defun LM:popup ( ttl msg bit / wsh rtn ) (if (setq wsh (vlax-create-object "wscript.shell")) (progn (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit))) (vlax-release-object wsh) (if (not (vl-catch-all-error-p rtn)) rtn) ) ) ) (LM:popup "PC System Info" infomsg (+ 0 64 4096)) (princ) ) I've put together some nice code written by dilan, for beginners like me. Others have also been collected and links have been attached. command is SYSINFO - Drive serial is not manufacturer's unique serial number. this can be change with just formatting