566 lines
14 KiB
Plaintext
566 lines
14 KiB
Plaintext
;;; ACAD.MNL
|
|
;;; Copyright (C) 1992 - 1997 by Autodesk, Inc.
|
|
;;;
|
|
;;; Permission to use, copy, modify, and distribute this software
|
|
;;; for any purpose and without fee is hereby granted, provided
|
|
;;; that the above copyright notice appears in all copies and
|
|
;;; that both that copyright notice and the limited warranty and
|
|
;;; restricted rights notice below appear in all supporting
|
|
;;; documentation.
|
|
;;;
|
|
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
|
|
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
|
|
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
|
|
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
|
|
;;; UNINTERRUPTED OR ERROR FREE.
|
|
;;;
|
|
;;; Use, duplication, or disclosure by the U.S. Government is subject to
|
|
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
|
|
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
|
|
;;; (Rights in Technical Data and Computer Software), as applicable.
|
|
;;;
|
|
;;; AutoLISP routines used by the AutoCAD Standard Menu.
|
|
;;;
|
|
;;; This file is loaded automatically following the menu ACAD.
|
|
|
|
(princ "\nAutoCAD Menü-Dienstprogramme ")
|
|
|
|
|
|
;;;=== Icon Menu Functions ===
|
|
|
|
;;; View -> Layout -> Tiled Viewports...
|
|
|
|
(defun ai_tiledvp_chk (new)
|
|
(setq m:err *error* *error* *merrmsg*)
|
|
|
|
(if (= (getvar "TILEMODE") 0)
|
|
(progn
|
|
(princ "\n** Befehl nicht erlaubt, außer TILEMODE ist auf 1 gesetzt (Ein) **")
|
|
(princ)
|
|
)
|
|
(progn
|
|
(if new
|
|
(menucmd "I=ACAD.IMAGE_VPORTI")
|
|
(menucmd "I=IMAGE_VPORTI")
|
|
)
|
|
(menucmd "I=*")
|
|
)
|
|
)
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
|
|
(defun ai_tiledvp (num ori / ai_tiles_g ai_tiles_cmde)
|
|
(setq m:err *error* *error* *merrmsg*
|
|
ai_tiles_cmde (getvar "CMDECHO")
|
|
ai_tiles_g (getvar "GRIDMODE")
|
|
)
|
|
(ai_undo_push)
|
|
(setvar "CMDECHO" 0)
|
|
(setvar "GRIDMODE" 0)
|
|
(cond ((= num 1)
|
|
(command "_.VPORTS" "_SI")
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
)
|
|
((< num 4)
|
|
(command "_.VPORTS" "_SI")
|
|
(command "_.VPORTS" num ori)
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
)
|
|
((= ori nil)
|
|
(command "_.VPORTS" "_SI")
|
|
(command "_.VPORTS" num)
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
)
|
|
((= ori "_L")
|
|
(command "_.VPORTS" "_SI")
|
|
(command "_.VPORTS" "2" "")
|
|
(setvar "CVPORT" (car (cadr (vports))))
|
|
(command "_.VPORTS" "2" "")
|
|
(command "_.VPORTS" "_J" "" (car (cadr (vports))))
|
|
(setvar "CVPORT" (car (cadr (vports))))
|
|
(command "_.VPORTS" "3" "_H")
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
)
|
|
(T
|
|
(command "_.VPORTS" "_SI")
|
|
(command "_.VPORTS" "2" "")
|
|
(command "_.VPORTS" "2" "")
|
|
(setvar "CVPORT" (car (caddr (vports))))
|
|
(command "_.VPORTS" "_J" "" (car (caddr (vports))))
|
|
(setvar "CVPORT" (car (cadr (vports))))
|
|
(command "_.VPORTS" "3" "_H")
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
(setvar "CVPORT" (car (cadddr (vports))))
|
|
(setvar "GRIDMODE" ai_tiles_g)
|
|
)
|
|
)
|
|
(ai_undo_pop)
|
|
(setq *error* m:err m:err nil)
|
|
(setvar "CMDECHO" ai_tiles_cmde)
|
|
(princ)
|
|
)
|
|
|
|
|
|
;;;=== General Utility Functions ===
|
|
|
|
;;; ai_popmenucfg -- retrieve parameter from cfg settings
|
|
;;; <param> is a string specifiying the parameter
|
|
|
|
(defun ai_popmenucfg (param)
|
|
(set (read param) (getcfg (strcat "CfgData/Menu/" param)))
|
|
)
|
|
|
|
;;; ai_putmenucfg -- store parameter in cfg settings
|
|
;;; <param> is a string specifiying the parameter
|
|
;;; <cfgval> is the value for that parameter
|
|
|
|
(defun ai_putmenucfg (param cfgval)
|
|
(setcfg (strcat "CfgData/Menu/" param) cfgval)
|
|
)
|
|
|
|
(defun *merr* (msg)
|
|
(ai_sysvar nil) ;; reset system variables
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
|
|
(defun *merrmsg* (msg)
|
|
(princ msg)
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
|
|
|
|
(defun ai_showedge_alert ()
|
|
(alert "Unsichtbare Kanten werden nach Regenerierung angezeigt.")
|
|
(princ)
|
|
)
|
|
|
|
(defun ai_hideedge_alert ()
|
|
(alert "Unsichtbare Kanten werden nach Regenerierung VERDECKT sein.")
|
|
(princ)
|
|
)
|
|
|
|
|
|
;;; --- ai_sysvar ------------------------------------------
|
|
;;; Change system variable settings and save current settings
|
|
;;; (Note: used by *merr* to restore system settings on error.)
|
|
;;;
|
|
;;; The <vars> argument is used to...
|
|
;;; restore previous settings (ai_sysvar NIL)
|
|
;;; set a single sys'var (ai_sysvar '("cmdecho" . 0))
|
|
;;; set multiple sys'vars (ai_sysvar '(("cmdecho" . 0)("gridmode" . 0)))
|
|
|
|
(defun ai_sysvar (vars / savevar pair varname varvalue varlist)
|
|
|
|
(setq varlist nil) ;; place holder for varlist
|
|
|
|
(defun savevar (varname varvalue / pair)
|
|
(cond
|
|
;; if new value is NIL, save current setting
|
|
((not varvalue)
|
|
(setq varlist
|
|
(cons
|
|
(cons varname (getvar varname))
|
|
varlist
|
|
)
|
|
)
|
|
)
|
|
;; change sys'var only if it's different
|
|
((/= (getvar varname) varvalue)
|
|
;; add current setting to varlist, change setting
|
|
(setq varlist
|
|
(cons
|
|
(cons varname (getvar varname))
|
|
varlist
|
|
)
|
|
)
|
|
(setvar varname varvalue)
|
|
)
|
|
(T nil)
|
|
)
|
|
)
|
|
|
|
(cond
|
|
;; reset all values
|
|
((not vars)
|
|
(foreach pair varlist
|
|
(setq varname (car pair)
|
|
varvalue (cdr pair)
|
|
)
|
|
(setvar varname varvalue)
|
|
)
|
|
(setq varlist nil)
|
|
)
|
|
|
|
((not (eq 'LIST (type vars)))
|
|
(princ "\nAI_SYSVAR: Falscher Argumenttyp.\n")
|
|
)
|
|
|
|
;; set a single system variable
|
|
((eq 'STR (type (car vars)))
|
|
(savevar (car vars) (cdr vars))
|
|
|
|
)
|
|
|
|
;; set multiple system variables
|
|
((and
|
|
(eq 'LIST (type (car vars)))
|
|
(eq 'STR (type (caar vars)))
|
|
)
|
|
(foreach pair vars
|
|
(setq varname (car pair)
|
|
varvalue (cdr pair)
|
|
)
|
|
(if (not (eq 'STR (type varname)))
|
|
(princ "\nAI_SYSVAR: Falscher Argumenttyp.\n")
|
|
(savevar varname varvalue)
|
|
)
|
|
)
|
|
)
|
|
|
|
(T (princ "\nAI_SYSVAR: Fehler im ersten Argument.\n"))
|
|
|
|
);cond
|
|
|
|
;; redefine ai_sysvar function to contain the value of varlist
|
|
(setq ai_sysvar
|
|
(cons (car ai_sysvar)
|
|
(cons (list 'setq 'varlist (list 'quote varlist))
|
|
(cddr ai_sysvar)
|
|
)
|
|
)
|
|
)
|
|
|
|
varlist ;; return the list
|
|
|
|
);sysvar
|
|
|
|
|
|
;;; return point must be on an entity
|
|
;;;
|
|
(defun ai_entsnap (msg osmode / entpt)
|
|
(while (not entpt)
|
|
(setq entpt (last (entsel msg)))
|
|
)
|
|
(if osmode
|
|
(setq entpt (osnap entpt osmode))
|
|
)
|
|
entpt
|
|
)
|
|
|
|
;;;
|
|
;;; These UNDO handlers are taken from ai_utils.lsp and copied here to
|
|
;;; avoid loading all of ai_utils.lsp. Command echo control has also
|
|
;;; been added so that UNDO commands aren't echoed everywhere.
|
|
;;;
|
|
;;; UNDO handlers. When UNDO ALL is enabled, Auto must be turned off and
|
|
;;; GROUP and END added as needed.
|
|
;;;
|
|
(defun ai_undo_push()
|
|
(ai_sysvar '("cmdecho" . 0))
|
|
(setq undo_init (getvar "undoctl"))
|
|
(cond
|
|
((and (= 1 (logand undo_init 1)) ; enabled
|
|
(/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON)
|
|
(/= 8 (logand undo_init 8)) ; no GROUP active
|
|
)
|
|
(command "_.undo" "_group")
|
|
)
|
|
(T)
|
|
)
|
|
;; If Auto is ON, turn it off.
|
|
(if (= 4 (logand 4 undo_init))
|
|
(command "_.undo" "_auto" "_off")
|
|
)
|
|
(ai_sysvar NIL)
|
|
)
|
|
|
|
;;;
|
|
;;; Add an END to UNDO and return to initial state.
|
|
;;;
|
|
(defun ai_undo_pop()
|
|
(ai_sysvar '("cmdecho" . 0))
|
|
(cond
|
|
((and (= 1 (logand undo_init 1)) ; enabled
|
|
(/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON)
|
|
(/= 8 (logand undo_init 8)) ; no GROUP active
|
|
)
|
|
(command "_.undo" "_end")
|
|
)
|
|
(T)
|
|
)
|
|
;; If it has been forced off, turn it back on.
|
|
(if (= 4 (logand undo_init 4))
|
|
(command "_.undo" "_auto" "_on")
|
|
)
|
|
(ai_sysvar NIL)
|
|
)
|
|
|
|
;;;=== Menu Functions ======================================
|
|
|
|
(defun ai_rootmenus ()
|
|
(setq T_MENU 0)
|
|
(menucmd "S=S")
|
|
(menucmd "S=ACAD.S")
|
|
(princ)
|
|
)
|
|
|
|
(defun c:ai_fms ( / fmsa fmsb)
|
|
(setq m:err *error* *error* *merr*)
|
|
(ai_undo_push)
|
|
(if (getvar "TILEMODE") (setvar "TILEMODE" 0))
|
|
(setq fmsa (vports) fmsb (nth 0 fmsa))
|
|
(if (member 1 fmsb)
|
|
(if (> (length fmsa) 1)
|
|
(command "_.mspace")
|
|
(progn
|
|
(ai_sysvar '("cmdecho" . 1))
|
|
(command "_.mview")
|
|
(while (eq 1 (logand 1 (getvar "CMDACTIVE")))
|
|
(command pause)
|
|
)
|
|
(ai_sysvar NIL)
|
|
(command "_.mspace")
|
|
)
|
|
)
|
|
)
|
|
(ai_undo_pop)
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
|
|
(defun c:ai_propchk ( / a)
|
|
(setq m:err *error* *error* *merr*)
|
|
(if (not (setq a (ssget "_I")))
|
|
(setq a (ssget))
|
|
)
|
|
(if (> (sslength a) 1)
|
|
(progn
|
|
(if (not ddchprop)
|
|
(load "ddchprop")
|
|
)
|
|
(setq *error* m:err m:err nil)
|
|
(ddchprop a)
|
|
)
|
|
(progn
|
|
(if (not ddmodify)
|
|
(load "ddmodify")
|
|
)
|
|
(setq *error* m:err m:err nil)
|
|
(ddmodify (ssname a 0))
|
|
)
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
(defun ai_onoff (var)
|
|
(setvar var (abs (1- (getvar var))))
|
|
(princ)
|
|
)
|
|
|
|
;;; go to paper space
|
|
(defun c:ai_pspace ()
|
|
(ai_undo_push)
|
|
(if (/= 0 (getvar "tilemode"))
|
|
(command "_.tilemode" 0)
|
|
)
|
|
(if (/= 1 (getvar "cvport"))
|
|
(command "_.pspace")
|
|
)
|
|
(ai_undo_pop)
|
|
(princ)
|
|
)
|
|
|
|
;;; go to tilemode 1
|
|
(defun c:ai_tilemode1 ()
|
|
(ai_undo_push)
|
|
(if (/= 1 (getvar "tilemode"))
|
|
(command "_.tilemode" 1)
|
|
)
|
|
(ai_undo_pop)
|
|
(princ)
|
|
)
|
|
|
|
;;; Pop menu Draw/ Dim/ Align Text/ Centered
|
|
;;; Toolbar Dimensions/ Align Text/ Centered
|
|
|
|
(defun ai_dim_cen (/ ai_sysvar ai_dim_ss)
|
|
(setq ai_sysvar (getvar "cmdecho"))
|
|
(setvar "cmdecho" 0)
|
|
(cond
|
|
((setq ai_dim_ss (ssget "_P" '((0 . "DIMENSION"))))
|
|
(command "_.dimoverride" "_dimjust" 0 "" ai_dim_ss ""
|
|
"_.dimtedit" ai_dim_ss "_h")
|
|
)
|
|
(T nil)
|
|
)
|
|
(setvar "cmdecho" ai_sysvar)
|
|
(princ)
|
|
)
|
|
|
|
;;; Screen menu item for CIRCLE TaTaTan option.
|
|
;;; first, get points on entities
|
|
(defun ai_circtanstart()
|
|
(setq m:err *error* *error* *merr*)
|
|
(ai_sysvar
|
|
(list '("cmdecho" . 0)
|
|
;; make sure _tan pick for CIRCLE gets same entity
|
|
(cons "aperture" (getvar "pickbox"))
|
|
)
|
|
)
|
|
;; prompts are the same as CIRCLE/TTR command option
|
|
(setq pt1 (ai_entsnap "\nEingabe der Tangentenspezifikation: " nil))
|
|
(setq pt2 (ai_entsnap "\nEingabe der zweiten Tangentenspezifikation: " nil))
|
|
(setq pt3 (ai_entsnap "\nEingabe der dritten Tangentenspezifikation: " nil))
|
|
)
|
|
;;; Command-line version
|
|
(defun c:ai_circtan (/ pt1 pt2 pt3)
|
|
(ai_circtanstart)
|
|
|
|
(ai_sysvar '("osmode" . 256))
|
|
(command "_.circle" "_3p" "_tan" pt1 "_tan" pt2 "_tan" pt3)
|
|
|
|
(ai_sysvar nil)
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
;;; Use this if CMDNAMES == CIRCLE
|
|
(defun ai_circtan (/ pt1 pt2 pt3)
|
|
(ai_circtanstart)
|
|
|
|
(ai_sysvar '("osmode" . 256))
|
|
(command "_3p" pt1 pt2 pt3)
|
|
|
|
(ai_sysvar nil)
|
|
(setq *error* m:err m:err nil)
|
|
(princ)
|
|
)
|
|
|
|
|
|
|
|
;;;=== Make Object's Layer Current =============================
|
|
|
|
;; Makes the layer of the selected object current. If there is one
|
|
;; object in the pickfirst set, it's layer is made current without
|
|
;; prompting for an object. Else a prompt is issued.
|
|
(defun c:ai_molc(/ old_error end_undo old_cmdecho set1 ent undo_control)
|
|
|
|
;; Simple error handling.
|
|
(defun molc_error (s)
|
|
;; Reset error handling.
|
|
(if old_error (setq *error* old_error))
|
|
;; End undo if we started one.
|
|
(if (eq end_undo 1) (command "_.undo" "_end"))
|
|
;; Reset command echo
|
|
(if old_cmdecho (setvar "cmdecho" old_cmdecho))
|
|
;; Silent exit.
|
|
(princ)
|
|
)
|
|
|
|
;; Save current error function.
|
|
(setq old_error *error*)
|
|
|
|
;; Set error handling to molc's error function.
|
|
(setq *error* molc_error)
|
|
|
|
;; Save cmdecho setting.
|
|
(setq old_cmdecho (getvar "cmdecho"))
|
|
|
|
;; Turn off cmdecho
|
|
(setvar "cmdecho" 0)
|
|
|
|
;; If Pickfirst is on and the selction set contains
|
|
;; one object, then use it, else prompt for one.
|
|
(if (and (eq 1 (logand 1 (getvar "pickfirst")))
|
|
(setq set1 (ssget "_i"))
|
|
(eq 1 (sslength set1))
|
|
)
|
|
(progn
|
|
(setq ent (entget (ssname set1 0)))
|
|
(sssetfirst nil nil)
|
|
)
|
|
(progn
|
|
(sssetfirst nil nil)
|
|
(setq ent (entget (car (entsel "\nObjekt auswählen, dessen Layer der aktuelle Layer wird: "))))
|
|
)
|
|
)
|
|
|
|
;; Get undo setting.
|
|
(setq undo_control (getvar "undoctl"))
|
|
|
|
;; Initialize flag to to end undo.
|
|
(setq end_undo 0)
|
|
|
|
;; Begin Undo group if need be.
|
|
(if (and (= 1 (logand 1 undo_control)) ; undo on
|
|
(/= 2 (logand 2 undo_control)) ; not single undo
|
|
(/= 8 (logand 8 undo_control)) ; no active group
|
|
)
|
|
(progn
|
|
;; Begin a new one
|
|
(command "_.undo" "_begin")
|
|
;; Set flag so that we know to end undo.
|
|
(setq end_undo 1)
|
|
)
|
|
)
|
|
|
|
;; Make object's layer current.
|
|
(setvar "clayer" (cdr (assoc '8 ent)))
|
|
|
|
;; Print message
|
|
(princ (strcat "\n" (getvar "clayer") " ist jetzt der aktuelle Layer."))
|
|
|
|
;; Undo end
|
|
(if (eq 1 end_undo)
|
|
(command "_.undo" "_end")
|
|
)
|
|
|
|
;; Turn on cmdecho
|
|
(setvar "cmdecho" old_cmdecho)
|
|
|
|
;; Reset error function.
|
|
(setq *error* old_error)
|
|
|
|
;; Silent exit.
|
|
(princ)
|
|
)
|
|
|
|
;;;
|
|
;;; Enable Draworder to be called from a menu
|
|
;;; Checks for Pickfirst selected objects
|
|
;;;
|
|
|
|
(defun ai_draworder (option / ss )
|
|
|
|
(setq m:err *error* *error* *merr*)
|
|
(ai_sysvar '("cmdecho" . 0))
|
|
|
|
(if (setq ss (ssget "_I"))
|
|
(command "_.draworder" option)
|
|
(if (setq ss (ssget))
|
|
(command "_.draworder" ss "" option)
|
|
)
|
|
)
|
|
(ai_sysvar NIL)
|
|
(setq *error* m:err m:err nil)
|
|
|
|
(princ)
|
|
)
|
|
|
|
|
|
|
|
(princ "geladen.")
|
|
(princ)
|