Commits

Panagiotis Mavrogiorgos committed 167591c

Added support for transparent ortho.

  • Participants
  • Parent commits 262efd6

Comments (0)

Files changed (1)

File Lisp/command_aliases.lsp

-;---------------------------------------------------------------------------
-; Custom functions
-;---------------------------------------------------------------------------
-
-; Toggle ortho and toggle snap are not transparent.
-; This means that they cannot be called during the execution 
-; of another command (e.g. line).
-(defun toggle_ortho ()
-    (setvar "orthomode" (abs (1- (getvar "orthomode"))))
-    (princ)
-)
-
-(defun toggle_osnap ()
-    (setvar "osmode" (boole 6 (getvar "osmode") 16384))
-    (princ)
-)
-
-; For some reason the copy alias doesn't default to "multiple copy" mode.
-; The following routine fixes this.
-(defun multiple_copy ( / ss1 bpt)
-	(while (not ss1)
-		(princ "\nCopy multiple: ")
-		(setq ss1 (ssget))
-	);while
-	(while (not (setq bpt (getpoint "\nSpecify base point: "))))
-	(command "._copy" ss1 "" "m" bpt)
-)
-
-;---------------------------------------------------------------------------
-; Defines some custom shortcuts
-;---------------------------------------------------------------------------
-(defun C:a ()       (command "_.line"))                     ; Line
-(defun C:aa ()      (command "_.pline"))                    ; PolyLine
-(defun C:c ()       (multiple_copy))                        ; Copy
-(defun C:cc ()      (command "_.circle"))                   ; Circle
-(defun C:d ()       (command "_.offset"))                   ; Offset
-(defun C:e ()       (command "_.erase"))                    ; Erase
-(defun C:f ()       (command "_.move"))                     ; Move
-(defun C:ff ()      (command "_.fillet"))                   ; Fillet
-
-(defun C:r ()       (command "_.rotate"))                   ; Rotate
-(defun C:rr ()      (command "_.mirror"))                   ; Mirror
-(defun C:s ()       (command "_.stretch"))                  ; Stretch
-(defun C:v ()       (command "_.pasteclip"))                ; Pasteclip
-(defun C:w ()       (command "_.matchprop"))                ; Matchprop
-(defun C:xh ()      (command "_.xline" "H"))                ; Horizontal Xline
-(defun C:xv ()      (command "_.xline" "V"))                ; Vertical Xline
+;---------------------------------------------------------------------------
+; Custom functions
+;---------------------------------------------------------------------------
 
-(defun C:q ()       (command "_.dimlinear"))                ; Linear Dimension
-(defun C:qa ()      (command "_.dimaligned"))               ; Align Dimension
-(defun C:qb ()      (command "_.dimbaseline"))              ; Baseline Dimension
-(defun C:qc ()      (command "_.dimcontinue"))              ; Continue Dimension
-
-(defun C:f1 ()      (toggle_ortho))                         ; Toggle Ortho
+; Toggle ortho and toggle snap are not transparent.
+; This means that they cannot be called during the execution
+; of another command (e.g. line).
+(defun toggle_ortho ()
+    (setvar "orthomode" (abs (1- (getvar "orthomode"))))
+    (princ)
+)
+
+(defun toggle_osnap ()
+    (setvar "osmode" (boole 6 (getvar "osmode") 16384))
+    (princ)
+)
+
+; For some reason the copy alias doesn't default to "multiple copy" mode.
+; The following routine fixes this.
+(defun multiple_copy ( / ss1 bpt)
+    (while (not ss1)
+        (princ "\nCopy multiple: ")
+        (setq ss1 (ssget))
+    );while
+    (while (not (setq bpt (getpoint "\nSpecify base point: "))))
+    (command "._copy" ss1 "" "m" bpt)
+)
+
+;---------------------------------------------------------------------------
+; Defines some custom shortcuts
+;---------------------------------------------------------------------------
+(defun C:a ()       (command "_.line"))                     ; Line
+(defun C:aa ()      (command "_.pline"))                    ; PolyLine
+(defun C:c ()       (multiple_copy))                        ; Copy
+(defun C:cc ()      (command "_.circle"))                   ; Circle
+(defun C:d ()       (command "_.move"))                     ; Move
+(defun C:e ()       (command "_.erase"))                    ; Erase
+(defun C:f ()       (command "_.offset"))                   ; Offset
+(defun C:ff ()      (command "_.fillet"))                   ; Fillet
+
+(defun C:r ()       (command "_.rotate"))                   ; Rotate
+(defun C:rr ()      (command "_.mirror"))                   ; Mirror
+(defun C:s ()       (command "_.stretch"))                  ; Stretch
+(defun C:v ()       (command "_.pasteclip"))                ; Pasteclip
+(defun C:w ()       (command "_.matchprop"))                ; Matchprop
+(defun C:xh ()      (command "_.xline" "H"))                ; Horizontal Xline
+(defun C:xv ()      (command "_.xline" "V"))                ; Vertical Xline
+
+(defun C:q ()       (command "_.dimlinear"))                ; Linear Dimension
+(defun C:qa ()      (command "_.dimaligned"))               ; Align Dimension
+(defun C:qb ()      (command "_.dimbaseline"))              ; Baseline Dimension
+(defun C:qc ()      (command "_.dimcontinue"))              ; Continue Dimension
+
+(defun C:f1 ()      (toggle_ortho))                         ; Toggle Ortho
 (defun C:f2 ()      (toggle_osnap))                         ; Toggle Osnap
-
-
-
-
-		
+
+;;This code is based on mccad and lazybone's code
+;;http://www.mjtd.com/BBS/dispbbs.asp?boardid=3&replyid=8516&id=18715&page=1&skin=0&landlord=0&Star=2
+;;Load the custom menu file to the last but one item
+;;the menu name is test.mnu,MENUGROUP=MYTEST
+;;based on the upper code, qjchen add the dynamic mnu file generation
+;;How to use: Load this function, and it automatic load "ldmu", which is to load menu,  if you want to unload this menu, pls use "uldmu"
+;; The definition of the shortcut
+;;F1:ortho switch(like F8, I dont know how to write the mnu file with "^L", so I have to use Lisp, thanks to Chuck Gabriel for this lisp code)
+;;F2-F5: for zoom
+;;ctrl+w:3dorbit
+;;ctrl+e:ellipse (this two function is for the learing of ctrl)
+
+;;Load menu file, by mccad and lazybone
+(defun c:ldmu (/ pre_filedia CNT)
+    (setq pre_filedia (getvar "filedia"))
+    (setvar "filedia" 0)
+    (command "menuload" (temp_menu))
+    (setq CNT 1)
+    (while (menucmd (strcat "P" (itoa CNT) ".1=?"))
+        (setq CNT (1+ CNT)))
+    (if (> CNT 1)
+        (setq CNT (- CNT 1))
+        (setq CNT 1))
+    (menucmd (strcat "P" (itoa CNT) "=+MYTEST.pop1"))
+    (setvar "filedia" pre_filedia)
+    (princ)
+)
+;;UnLoad menu file, by mccad and lazybone
+(defun c:uldmu (/ pre_filedia)
+    (setq pre_filedia (getvar "filedia"))
+    (setvar "filedia" 0)
+    (command "menuunload" "MYTEST")
+    (setvar "filedia" pre_filedia)
+    (princ)
+)
+
+;; dynamic menu file generation, by qjchen
+(defun temp_menu(/ menu_name f)
+    (setq menu_name (strcat (getenv "temp") "\\test" ".mnu")
+        f (OPEN menu_name "w"))
+    (write-line "***MENUGROUP=MYTEST" f)
+    (write-line "***POP1" f)
+    (write-line "**Alias" f)
+    (write-line "[/MMyDraw]" f)
+    (write-line "ID_Ellipse [/EEllipse]^c^cEllipse" f)
+    (write-line "***ACCELERATORS" f)
+    ;(write-line "[\"F2\"]'_zoom _w" f)
+    ;(write-line "[\"F3\"]'_zoom _p" f)
+    ;(write-line "[\"F4\"]'_zoom _e" f)
+    ;(write-line "[\"F5\"]'_pan" f)
+    ;(write-line "ID_Ellipse [CONTROL+\"E\"]" f)
+    ;(write-line "[CONTROL+\"w\"]'3DORBIT" f)
+    (write-line "[\"F1\"](setvar \"ORTHOMODE\" (if (zerop (getvar \"ORTHOMODE\")) 1 0))(princ)" f)
+    (close f)
+    menu_name
+)
+
+(c:ldmu)