You can't customize the object properties toolbar from within CAD (ie
dropdowns for layers, color, etc.) This lisp is supposed to be a nice front
end for those who don't want to touch the MNS file.
;|
****************************************************************************
**
Made by: CAD Solution
Date: June, 2000
Description:
1- The program ask for a mns file.
2- A dialog box appears and shows you what you presently have in the section
** TB_OBJECT_PROPERTIES -> ID_Layer
3- Check which the options you want to have in your Object Properties
toolbar.
4- Then click OK
The possible options are:
Layer, Lineweight, PlotStyle, DimStyle, UCSManager, ViewportScale
Usage:
Copy this file (objprop.lsp) and the file objprop.dcl in a AutoCAD search
path.
****************************************************************************
**|;
(defun
C:OBJP (/ CS:OLD_ERROR CS:OS CS:OLD_CMDECHO CS:LINE CS:OPEN_FILE
CS:K1 CS:K2 CS:K3 CS:K4 CS:K5 CS:K6 CS:FILE CS:LIGNEDEBUT
CS:REPERTOIRE_FICHIER CS:LIGNEDEBUT CS:TEXTE2 CS:LISTE
CS:LIST CS:NOM
)
(setq CS:OLD_ERROR *ERROR*)
(setq CS:OS (getvar "osmode"))
(setq CS:OLD_CMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun
*ERROR* (MSG)
(prompt MSG)
(setq *ERROR* CS:OLD_ERROR)
(setvar "osmode" CS:OS)
(setvar "cmdecho" CS:OLD_CMDECHO)
(setq
CS:OLD_CMDECHO NIL
CS:OLD_ERROR NIL
) ;_ end of setq
(princ)
)
;---------------------------------------------------------------------------
--------------------------------
; *** A partir de la ligne commencant par ID_LAYER (defun makelist), crée
une liste de ce qu'il
; y a dans cette section **TB_OBJECT_PROPERTIES jusqu'à ce qu'on arrive à
une ligne vide.
; Set les valeurs actuelles des toggles dans la boite dialogue afin que
l'usage sache ce que le .mns a déjà.
;---------------------------------------------------------------------------
--------------------------------
(defun
CS:MNSAVANTTRANSFO
(/ CS:FINSECTION CS:NB CS:CNT CS:TROUVECHARACTERE)
(setq CS:FINSECTION NIL)
(setq CS:LIST NIL)
(setq CS:LIST (append CS:LIST (list CS:LINE)))
(while
(and (/= CS:FINSECTION 1) (setq CS:LINE (read-line CS:OPEN_FILE)))
(setq CS:NB (strlen CS:LINE))
(setq CS:CNT 1)
(setq CS:TROUVECHARACTERE NIL)
(while (and (< CS:CNT CS:NB) (= CS:TROUVECHARACTERE NIL))
(if (/= (substr CS:LINE CS:CNT 1) " ")
(setq CS:TROUVECHARACTERE 1)
) ;_ end of if
(setq CS:CNT (1+ CS:CNT))
) ;_ end of while
(if (= CS:TROUVECHARACTERE NIL)
(setq CS:FINSECTION 1)
(progn
(setq CS:LIST (append CS:LIST (list CS:LINE)))
(cond
((= (substr CS:LINE (1- CS:CNT) CS:NB) "[_Control(_Layer)]")
(setq CS:K1 "1")
)
((= (substr CS:LINE (1- CS:CNT) CS:NB)
"[_Control(_Lineweight)]"
) ;_ end of =
(setq CS:K2 "1")
)
((= (substr CS:LINE (1- CS:CNT) CS:NB)
"[_Control(_PlotStyle)]"
) ;_ end of =
(setq CS:K3 "1")
)
((= (substr CS:LINE (1- CS:CNT) CS:NB)
"[_Control(_DimStyle)]"
) ;_ end of =
(setq CS:K4 "1")
)
((= (substr CS:LINE (1- CS:CNT) CS:NB)
"[_Control(_UCSManager)]"
) ;_ end of =
(setq CS:K5 "1")
)
((= (substr CS:LINE (1- CS:CNT) CS:NB)
"[_Control(_ViewportScale)]"
) ;_ end of =
(setq CS:K6 "1")
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
) ;_ end of while
CS:LIST
)
;---------------------------------------------------------------------------
------------------------
; *** Cherche la ligne dans le .mns qui commence par ID_Layer sous la
section **TB_OBJECT_PROPERTIES
;---------------------------------------------------------------------------
------------------------
(defun
CS:POINTEUR (/ CS:TROUVE CS:LINE CS:CARAC CS:ID_LAYER CS:TROUVE2)
(setq CS:TROUVE NIL)
(while
(and (/= CS:TROUVE 1) (setq CS:LINE (read-line CS:OPEN_FILE)))
(if (= (substr CS:LINE 1 22) "**TB_OBJECT_PROPERTIES")
(progn
(setq CS:TROUVE 1)
(setq CS:CARAC 1)
(setq CS:LINE (read-line CS:OPEN_FILE))
(while (and
(/= (substr CS:LINE CS:CARAC 1) " ")
(< CS:CARAC (strlen CS:LINE))
) ;_ end of and
(setq CS:CARAC (1+ CS:CARAC))
) ;_ end of while
(if (/= (strcase (substr CS:LINE 1 (1- CS:CARAC)))
"ID_TBOBJECTP"
) ;_ end of /=
(progn
(close CS:OPEN_FILE)
(alert
"The first line under **TB_OBJECT_PROPERTIES is not a ID_TbObjectP."
) ;_ end of alert
(exit)
) ;_ end of progn
) ;_ end of if
(setq CS:ID_LAYER "1")
(setq CS:TROUVE2 NIL)
(while (and
(/= (strcase CS:ID_LAYER) "ID_LAYER")
(/= CS:TROUVE2 1)
) ;_ end of and
(setq CS:CARAC 1)
(setq CS:LINE (read-line CS:OPEN_FILE))
(while (and
(/= (substr CS:LINE CS:CARAC 1) " ")
(< CS:CARAC (strlen CS:LINE))
) ;_ end of and
(setq CS:CARAC (1+ CS:CARAC))
) ;_ end of while
(if (= (setq
CS:ID_LAYER
(strcase (substr CS:LINE 1 (1- CS:CARAC)))
) ;_ end of setq
"ID_LAYER"
) ;_ end of =
(progn (setq CS:TROUVE2 1) (setq CS:LIGNEDEBUT CS:LINE))
) ;_ end of if
(if (= (substr CS:LINE 1 2) "**")
(progn
(close CS:OPEN_FILE)
(alert "**TB_OBJECT_PROPERTIES has no ID_Layer.")
(exit)
) ;_ end of progn
) ;_ end of if
) ;_ end of while
) ;_ end of progn
) ;_ end of if
) ;_ end of while
CS:LINE
)
;---------------------------------------------------------------------------
-------------
; *** Construit le texte de remplacement à partir de ID_LAYER sous
**TB_OBJECT_PROPERTIES
;---------------------------------------------------------------------------
-------------
(defun
CS:CONSTRUCTIONTEXTE (/ CS:STR CS:CNT CS:NB)
(setq CS:STR NIL)
(setq
CS:STR
(append
CS:STR
(list
"ID_Layer [_Button(\"Layers\", \"ICON_16_LAYERS\",
\"ICON_16_LAYERS\")]'_layer"
) ;_ end of list
) ;_ end of append
) ;_ end of setq
(if (= CS:K1 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_Layer)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(if (= CS:K2 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_Lineweight)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(if (= CS:K3 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_PlotStyle)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(if (= CS:K4 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_DimStyle)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(if (= CS:K5 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_UCSManager)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(if (= CS:K6 "1")
(setq
CS:STR
(append
CS:STR
(list " [_Control(_ViewportScale)]")
) ;_ end of append
) ;_ end of setq
) ;_ end of if
(setq CS:TEXTE2 NIL)
(setq CS:CNT 0)
(setq CS:NB (length CS:STR))
(repeat (- CS:NB CS:CNT)
(setq CS:TEXTE2 (append CS:TEXTE2 (list (nth CS:CNT CS:STR))))
(setq CS:CNT (1+ CS:CNT))
(if (/= CS:CNT CS:NB)
(setq CS:TEXTE2 (append CS:TEXTE2 (list " [--]")))
) ;_ end of if
) ;_ end of repeat
(done_dialog 1)
)
;---------------------------------------------------------------------------
--
; *** Ecris le nouveau texte dans csi_acad_mns_temporaire.txt, puis,
transfère
; le contenu de csi_acad_mns_temporaire.txt, dans le .mns
;---------------------------------------------------------------------------
--
(defun
CS:ECRITUREDANSMNS (/ CS:MNS_FILE CS:REPERTOIRE CS:FICHIERTEMP
CS:WRITE_FILE CS:IN CS:READ1 CS:CNT CS:NB
CS:TEXTE CS:READ_FILE
)
(setq CS:MNS_FILE (open CS:FILE "r")) ; acad.mns
(setq CS:REPERTOIRE (nth 0 CS:REPERTOIRE_FICHIER))
(setq
CS:FICHIERTEMP
(strcat
CS:REPERTOIRE
"csi_acad_mns_temporaire.txt"
) ;_ end of strcat
) ;_ end of setq
(setq CS:WRITE_FILE (open CS:FICHIERTEMP "w"))
; écriture de la 1ere partie du .mns
(setq CS:IN 1)
(setq CS:READ1 (read-line CS:MNS_FILE))
(while CS:IN
(if CS:READ1
(if (/= CS:LIGNEDEBUT CS:READ1)
(write-line CS:READ1 CS:WRITE_FILE)
(setq CS:IN NIL)
) ;_ end of if
) ;_ end of if
(setq CS:READ1 (read-line CS:MNS_FILE))
) ; écriture de la nouvelle section du **TB_OBJECT_PROPERTIES
(setq CS:CNT 0)
(setq CS:NB (length CS:TEXTE2))
(repeat (- CS:NB CS:CNT)
(setq CS:TEXTE (list (nth CS:CNT CS:TEXTE2)))
(write-line (car CS:TEXTE) CS:WRITE_FILE)
(setq CS:CNT (1+ CS:CNT))
) ;_ end of repeat
(write-line " " CS:WRITE_FILE) ; ligne vide
; écriture de la dernière partie du .mns à partir de la prochaine section
commencant par **
(setq CS:IN 1)
(while CS:IN
(if (/= (substr CS:READ1 1 2) "**")
(setq CS:READ1 (read-line CS:MNS_FILE))
(setq CS:IN NIL)
) ;_ end of if
) ;_ end of while
(setq CS:IN 1)
(while CS:IN
(if CS:READ1
(write-line CS:READ1 CS:WRITE_FILE)
(setq CS:IN NIL)
) ;_ end of if
(setq CS:READ1 (read-line CS:MNS_FILE))
) ; fermeture des 2 fichiers
(close CS:MNS_FILE)
(close CS:WRITE_FILE)
; copier le contenu de csi_acad_mns_temporaire.txt dans acad.mns
(setq CS:READ_FILE (open CS:FICHIERTEMP "r")) ; lecture
(setq CS:MNS_FILE (open CS:FILE "w")) ; écriture
(setq CS:IN 1)
(setq CS:READ1 (read-line CS:READ_FILE))
(while CS:IN
(if CS:READ1
(write-line CS:READ1 CS:MNS_FILE)
(setq CS:IN NIL)
) ;_ end of if
(setq CS:READ1 (read-line CS:READ_FILE))
) ; fermeture des 2 fichiers
(close CS:MNS_FILE)
(close CS:READ_FILE) ; effacer csi_acad_mns_temporaire.txt
(command ".sh" (strcat "del " CS:FICHIERTEMP))
)
;---------------------------------------------------------------------------
---------------------
; INPUT
; CS:PATH = chemin complet d'un fichier
; OUTPUT
; CS:LISTE = liste de 2 éléments: répertoire et fichier ex:
d:\\acad2000\support\\ et acad.mns
;---------------------------------------------------------------------------
---------------------
(defun
CS:DIRECTORY (CS:PATH / CS:NB CS:FIN CS:LONG CS:TST CS:CT CS:REPER
CS:NAME CS:CHECK
)
(setq CS:NB (strlen CS:PATH))
(setq
CS:FIN CS:NB
CS:LONG 1
CS:TST 1
CS:CT 0
CS:LISTE
'()
) ;_ end of setq
(while CS:TST
(setq CS:CHECK (substr CS:PATH CS:FIN CS:LONG))
(setq CS:CT (1+ CS:CT))
(if (= CS:CHECK "\\")
(setq CS:TST NIL)
(setq CS:FIN (1- CS:FIN)) ; si check /= a \\
) ;_ end of if
(if (= CS:CT CS:NB) ; Protection au cas-ou il n'y a pas de \\
(setq CS:TST NIL)
) ;_ end of if
) ;_ end of while
(setq CS:REPER (substr CS:PATH 1 CS:FIN))
(if (/= CS:FIN 0)
(setq CS:NAME (substr CS:PATH (1+ CS:FIN) CS:NB))
(setq CS:NAME CS:PATH)
) ;_ end of if
(setq CS:LISTE (append CS:LISTE (list CS:REPER) (list CS:NAME)))
CS:LISTE
)
;---------------------------------------------------------------------------
---
(setq CS:VER (getvar "acadver"))
(if (/= (substr CS:VER 1 2) "15")
(progn (alert "This program works on AutoCAD 2000") (exit))
) ;_ end of if
(setvar "osmode" 0)
(setq CS:FILE NIL)
(setq CS:FILE (getfiled "Choose a .mns file to modify" "" "mns" 2))
(if CS:FILE
(progn
(setq CS:REPERTOIRE_FICHIER (CS:DIRECTORY CS:FILE))
(setq CS:NOM (nth 1 CS:REPERTOIRE_FICHIER))
(if (/= (substr CS:NOM (- (strlen CS:NOM) 2)) "mns")
(progn (alert "The file is not a .mns.") (exit))
) ;_ end of if
(setq CS:OPEN_FILE (open CS:FILE "r"))
) ;_ end of progn
(progn (alert "No .mns file.") (exit))
) ;_ end of if
(setq CS:LINE (CS:POINTEUR))
(if (= CS:LIGNEDEBUT NIL)
(progn
(close CS:OPEN_FILE)
(alert
"In the .mns, there is no ID_LAYER under **TB_OBJECT_PROPERTIES."
) ;_ end of alert
(exit)
) ;_ end of progn
) ;_ end of if
(setq
CS:K1 "0"
CS:K2 "0"
CS:K3 "0"
CS:K4 "0"
CS:K5 "0"
CS:K6 "0"
CS:W_NEXT 3
) ;_ end of setq
(setq CS:LIST (CS:MNSAVANTTRANSFO))
(close CS:OPEN_FILE)
(setq CS:ID (load_dialog "objprop.dcl"))
(while (> CS:W_NEXT 1)
(new_dialog "objprop" CS:ID)
(set_tile "lay" CS:K1)
(set_tile "lweight" CS:K2)
(set_tile "pstyle" CS:K3)
(set_tile "dstyle" CS:K4)
(set_tile "ucsman" CS:K5)
(set_tile "vpscale" CS:K6)
(action_tile "lay" "(setq CS:K1 $value)")
(action_tile "lweight" "(setq CS:K2 $value)")
(action_tile "pstyle" "(setq CS:K3 $value)")
(action_tile "dstyle" "(setq CS:K4 $value)")
(action_tile "ucsman" "(setq CS:K5 $value)")
(action_tile "vpscale" "(setq CS:K6 $value)")
(action_tile "accept" "(CS:CONSTRUCTIONTEXTE)")
(action_tile "cancel" "(done_dialog 0)")
(setq CS:W_NEXT (start_dialog))
) ;_ end of while
(unload_dialog CS:ID)
(if (= 1 CS:W_NEXT)
(progn (CS:ECRITUREDANSMNS) (command ".menu" CS:FILE))
) ;_ end of if
(setq *ERROR* CS:OLD_ERROR)
(setvar "cmdecho" CS:OLD_CMDECHO)
(setvar "osmode" CS:OS)
(setq
CS:OLD_CMDECHO NIL
CS:OLD_ERROR NIL
) ;_ end of setq
(princ)
) ;_ end of defun
;---------------------------------------------------------------------------
---
(defun C:OBJPROP () (C:OBJP))
;---------------------------------------------------------------------------
--
(princ "\nType objprop")
(princ)
"Jason Piercey" wrote in message
news:BA894012845AEE5538D30544FA876C26@in.WebX.maYIadrTaRb...
> The .dcl file stores the dialog interface. The .lsp file calls the .dcl
> file to activate the dialog. However, I'm not sure why you would need a
> lisp routine to change toolbar appearances. You can open any .mns file
with
> a text editor and accomplish the same thing as this routine is doing.
> Toolbars can also be customized from within the drawing editor of AutoCAD.
>
> --
> -Jason
>
> Member of the Autodesk Discussion Forum Moderator Program
>
>
> > cadalyst oct tip # 1829 [objprop.lsp] and objprop.dcl] allows you to
> change the object properties toolbar.
> > I put the .lsp and .dcl into my support and loaded the .lsp into my dwg.
> start the command pick the acad.mns file and nothing happens. not sure
what
> i am doing wrong and what does a .dcl file do
>
>
>
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
