DOSLib | Developer Tools Popup Menu

This thread was inspired by Alanjt, who kindly reminded me of the usefulness of DOSLib, which I had forgotten and/or ignored previously.

Here's an example of a popup menu I made (thanks to Alan's kick-start), which holds some Developer Tools:

(defun c:`  (/ *error* lst opt oldCmdecho)
 ;; © RenderMan, 2011, CADTutor.net
 ;; Inspired by Alan J. Thompson

 ;; Error handler
 (defun *error*  (msg)
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (and oldCmdecho (setvar 'cmdecho oldCmdecho))
   (princ))

 ;; Main code
 (if (setq opt
            (dos_popupmenu
              (setq lst '("DUMP        | Dump Object"
                          "DUMPDOC | Dump Active Document"
                          "DUMPLAY  | Dump Layer" ""
                          "BATT         | List Block Attributes"
                          "ELS            | List Entity Data" ""
                          "Load ACAD.lsp" "Load ACADDOC.lsp" ""
                          "System Variable Editor" "" "Visual LISP IDE"
                          "" "Visual Basic for Applications IDE" "" "Visual Basic 2010 Express"
                          "Visual C++ 2010 Express" "Visual C# 2010 Express" ))
              (mapcar (function (lambda (x)
                                  (if (eq "" x)
                                    1
                                    0)))
                      lst)))
   (progn
     (and (setq oldCmdecho (getvar 'cmdecho)) (setvar 'cmdecho 0))
     (cond ((= 0 opt)
            (princ "\rDUMP OBJECT ")
            (c:DUMP))
           ((= 1 opt)
            (princ "\rDUMP ACTIVE DOCUEMENT")
            (c:DUMPDOC))
           ((= 2 opt)
            (princ "\rDUMP LAYER ")
            (C:DUMPLAY))
           ((= 3 opt)
            (princ "\rLIST BLOCK ATTRIBUTES ")
            (c:BATT))
           ((= 4 opt)
            (princ "\rLIST ENTITY DATA ")
            (c:ELS))
           ((= 5 opt)
            (load "acad.lsp"))
           ((= 6 opt)
            (load "acaddoc.lsp"))
           ((= 7 opt)
            (princ "\rSYSTEM VARIABLE EDITOR ")
            (command "._sysvdlg"))
           ((= 8 opt)
            (princ "\rVLIDE ")
            (c:VLIDE))
           ((= 9 opt)
            (princ "\rVBAIDE ")
            (command "vbaide"))
           ((= 10 opt)
            (princ "\rSTART: VISUAL BASIC 2010 EXPRESS ")
            (command "start" "vbexpress.exe"))
           ((= 11 opt)
            (princ "\rSTART: VISUAL C++ 2010 EXPRESS ")
            (command "start" "VCExpress.exe"))
           ((= 12 opt)
            (princ "\rSTART: VISUAL C# 2010 EXPRESS ")
            (command "start" "VCSExpress.exe")))
     (setvar 'cmdecho oldCmdecho)))
 (princ))

Note - Sub-functions not included.

Screen shot:

No matter how many posts I make, there is always more to learn - that's one of the many reasons I enjoy being a member of CADTutor!

Hopefully this will help some of you, the way it has helped me.

Cheers!

Here's one I did for curve/bearing tools...

(defun c:BT (/ lst opt)
 ;; Bearing Tools
 ;; Alan J. Thompson
 (if (setq opt (dos_popupmenu
                 (mapcar (function car)
                         (setq lst '(("Line by Bearing & Distance"
                                      .
                                      (command
                                       "_.line"
                                       "_non"
                                       (cond
                                        ((getpoint "\nSpecify starting point: "))
                                        ((getvar 'lastpoint))
                                       )
                                       "'BD"
                                      )
                                     )
                                     ("")
                                     ("Curve from End of Object" . (command "_.CURVEFROMENDOFOBJECT"))
                                     ("Reverse or Compound Curve" . (command "_.REVERSEORCOMPOUND"))
                                     ("")
                                     ("Angle Inquiry" . (command "_.CGANG"))
                                     ("Line Inquiry" . (command "_.CGLIST"))
                                    )
                         )
                 )
                 (mapcar (function (lambda (x)
                                     (if (eq "" (car x))
                                       1
                                       0
                                     )
                                   )
                         )
                         lst
                 )
               )
     )
   (progn (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command))
          (eval (cdr (nth opt (vl-remove '("") lst))))
   )
 )
 (princ)
)

And here's one I started but have been too lazy/busy (you pick) to add any of the other tools to it. It's for the random occasions when I have to do an As-Built survey. It's rare, so updating the tool is low priority...

(defun c:ABT (/ foo lst opt)
 ;; As-Built Tools
 ;; Alan J. Thompson, 05.02.11

 (defun foo (lg / lst) (while (< (length lst) lg) (setq lst (cons 0 lst))))

 (if (setq opt (dos_popupmenu
                 (append '(" * - * AS-BUILT TOOLS * - * " "")
                         (mapcar (function car)
                                 (setq lst '(("Remove TOP/INV prefixes" . (c:AB_NoTopOrInvLabels))
                                             ("Move Structure label" . (c:AB_MoveLabel))
                                             ("Slope Calculator" . (c:SlopeCalcLabel))
                                            )
                                 )
                         )
                 )
                 (append '(1 1) (foo (length lst)))
               )
     )
   (eval (cdr (nth (1- opt) lst)))
 )
 (princ)
)

Yes, of course! I forgot about eval (hence my re-structuring of lst)!!

No worries. I just thought I'd throw a couple more examples in the loop. I hope I've not stepped on any toes.

Not at all.

with load does not work unfortunately

mit load funktioniert das leider nicht

(defun c:A (/ foo lst opt)
 ;; As-Built Tools
 ;; Alan J. Thompson, 05.02.11

 (defun foo (lg / lst) (while (< (length lst) lg) (setq lst (cons 0 lst))))

 (if (setq opt (dos_popupmenu
                 (append '(" * - * ZÄHLER TOOLS * - * " "")
                         (mapcar (function car)
                                 (setq lst '(("Nummer + +0" . ((load"zahl_plus")(c:Zahl_plus)))
                                             ("Nummer - -0" . ((load"zahl_minus")(c:Zahl_minus)))
                                             ("Nummer + 200/1/+" . ((load"nummerhoch")(c:nummerhoch)))
                         ("Nummer - 200/1/-" . ((load"nummerminus")(c:nummerminus)))
                                    )
                                 )
                         )
                 )
                 (append '(1 1) (foo (length lst)))
               )
     )
   (eval (cdr (nth (1- opt) lst)))
 )
 (princ)
)

Why you can not use the load command

Warum kann man hier den load befehl nicht verwenden

Danke

(mapcar (function car) (setq lst '(("Nummer + +0" . ((load"zahl_plus")(c:Zahl_plus))) ("Nummer - -0" . ((load"zahl_minus")(c:Zahl_minus))) ("Nummer + 200/1/+" . ((load"nummerhoch")(c:nummerhoch))) ("Nummer - 200/1/-" . ((load"nummerminus")(c:nummerminus)))

Do you have DOSLib installed dober?

Yes I have, he wants me to take not only the load command.

Ja habe ich, er will mir nur den Befehl load nicht nehmen.

  (if (setq opt (dos_popupmenu
                 (append '(" * - * ZÄHLER TOOLS * - * " "")
                         (mapcar (function car)
                                 (setq lst '(("Nummer + +0" . ((load "plusnummer.lsp")(c:plusnummer)))
                                             ("Nummer - -0" . ((load "minusnummer.lsp")(c:minusnummer)))
                                             ("Nummer + 200/1/+" . (c:nummerhoch))
                         ("Nummer - 200/1/-" . (c:nummerminus))
                         ("Nummer + 200/+/0" . (c:z3hoch))
                         ("Nummer - 200/-/0" . (c:z3minus))
                                    )

You have two options, you can either wrap the calls in a progn statement or eval each item individually.

eg.

(defun c:A (/ foo lst opt)
 ;; Alan J. Thompson, 05.02.11
 ;; Modified by: dober

 (defun foo (lg / lst) (while (< (length lst) lg) (setq lst (cons 0 lst))))

 (if (setq
       opt (dos_popupmenu
             (append
               '(" * - * ZÄHLER TOOLS * - * " "")
               (mapcar (function car)
                       (setq lst '(("Nummer + +0" . (progn (load "zahl_plus") (c:Zahl_plus)))
                                   ("Nummer - -0" . (progn (load "zahl_minus") (c:Zahl_minus)))
                                   ("Nummer + 200/1/+" . (progn (load "nummerhoch") (c:nummerhoch)))
                                   ("Nummer - 200/1/-" . (progn (load "nummerminus") (c:nummerminus)))
                                  )
                       )
               )
             )
             (append '(1 1) (foo (length lst)))
           )
     )
   (eval (cdr (nth (1- opt) lst)))
 )
 (princ)
)

or

(defun c:A (/ foo lst opt)
 ;; Alan J. Thompson, 05.02.11
 ;; Modified by: dober

 (defun foo (lg / lst) (while (< (length lst) lg) (setq lst (cons 0 lst))))

 (if (setq
       opt (dos_popupmenu
             (append
               '(" * - * ZÄHLER TOOLS * - * " "")
               (mapcar (function car)
                       (setq lst '(("Nummer + +0" . ((load "zahl_plus") (c:Zahl_plus)))
                                   ("Nummer - -0" . ((load "zahl_minus") (c:Zahl_minus)))
                                   ("Nummer + 200/1/+" . ((load "nummerhoch") (c:nummerhoch)))
                                   ("Nummer - 200/1/-" . ((load "nummerminus") (c:nummerminus)))
                                  )
                       )
               )
             )
             (append '(1 1) (foo (length lst)))
           )
     )
   (mapcar (function eval) (cdr (nth (1- opt) lst)))
 )
 (princ)
)

I can't test it, but would something like this be clearer/easier to modify for the user:

(defun c:A ( / l1 n )
 ;; As-Built Tools
 ;; Alan J. Thompson, 05.02.11
 ;; Modified by Lee Mac 25.05.11

 (setq l1
  '(
     (" * - * ZÄHLER TOOLS * - * " 1)
     ("" 1)
     ("Nummer + +0"      0 (progn (if (or c:Zahl_plus   (load "zahl_plus"  nil)) (c:Zahl_plus))))
     ("Nummer - -0"      0 (progn (if (or c:Zahl_minus  (load"zahl_minus"  nil)) (c:Zahl_minus))))
     ("Nummer + 200/1/+" 0 (progn (if (or c:nummerhoch  (load"nummerhoch"  nil)) (c:nummerhoch))))
     ("Nummer - 200/1/-" 0 (progn (if (or c:nummerminus (load"nummerminus" nil)) (c:nummerminus))))
   )
 )

 (if (setq n (dos_popupmenu (mapcar 'car l1) (mapcar 'cadr l1)))
   (eval
     (caddr (nth (1- n) (vl-remove-if-not '(lambda ( x ) (zerop (cadr x))) l1)))
   )
 )
 (princ)
)

Super 1000 times thank you now it runs great :)

Super 1000 mal Danke jetzt läuft es super

I can't test it, but would something like this be clearer/easier to modify for the user:

Probably. This is what happens when you write stuff on the fly; it isn't always optimized.

Thank you guys all work great. :D:D

Danke Jungs alle Funktionieren super.

I can't test it, but would something like this be clearer/easier to modify for the user:

 

(defun c:A ( / l1 n )
;; As-Built Tools
;; Alan J. Thompson, 05.02.11
;; Modified by Lee Mac 25.05.11

(setq l1
'(
(" * - * ZÄHLER TOOLS * - * " 1)
("" 1)
("Nummer + +0" 0 (progn (if (or c:Zahl_plus (load "zahl_plus" nil)) (c:Zahl_plus))))
("Nummer - -0" 0 (progn (if (or c:Zahl_minus (load"zahl_minus" nil)) (c:Zahl_minus))))
("Nummer + 200/1/+" 0 (progn (if (or c:nummerhoch (load"nummerhoch" nil)) (c:nummerhoch))))
("Nummer - 200/1/-" 0 (progn (if (or c:nummerminus (load"nummerminus" nil)) (c:nummerminus))))
)
)

(if (setq n (dos_popupmenu (mapcar 'car l1) (mapcar 'cadr l1)))
(eval
(caddr (nth (1- n) (vl-remove-if-not '(lambda ( x ) (zerop (cadr x))) l1)))
)
)
(princ)
)

How can I put a reminder within this code to first set the CELTSCALE ?

I was thinking thus, but doesn't work,

("Set CELTSCALE" . (command "_.celtscale"))

tia

steve

If you are looking to add to the code that I modified, note that I restructured the list, so the entry might be:

("Set CELTSCALE" 0 (command "_.celtscale"))

thank you Lee very much

cheers: beer:

steve

You're welcome Steve