TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Adesu on November 28, 2006, 03:28:55 AM
-
Hi Alls,
I just create a code to blockade a user,if that user login with not same as my name,then user put code until 5 times,the program and I want blockade or Autocad exit,I knew this code should put in acaddoc.lsp or acad2005doc.lsp,but I still got problem how to count user login until 5 times in lisp program,anyone have time to look my code,and I very apreciated for your help,thanks.
Here Lsp file
(defun c:lnm (/ ans dcl_id nam)
(setq dcl_id (load_dialog "Login Name Manager.dcl"))
(if
(not (new_dialog "lnm" dcl_id))
(exit)
)
(set_tile "eb" "Abc")
(mode_tile "eb" 2)
(action_tile "eb" "(setq nam (get_tile \"eb\"))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)(exit)")
(setq ans (start_dialog))
(if
nam
(progn
(if (= nam "")(c:lnm))
(if
(or (= nam "Adesu")(= nam "adesu"))
(progn
(alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" nam))
(exit)
) ; progn
) ; if
(if
(or (/= nam "Adesu")(/= nam "adesu"))
(c:lnm)
) ; if
) ; progn
(c:lnm)
) ; if
(princ)
) ; defun
here DCL file
// lnm is for Login Name Manager
lnm : dialog {label = "LOGIN NAME MANAGER";
: column {label = "Enter your name here";
: edit_box {key = "eb";}}
ok_cancel;}
-
Hi
(defun c:lnm(/ cnt rep)
(defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
)
(defun InputBox (Titre Message Defaut / *acad* users1 valeur)
(setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
(acad-push-dbmod)
(vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
(setq valeur (getvar "users1"))
(setvar "users1" users1)
(acad-pop-dbmod)
valeur
)
(setq cnt 0)
(while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
(setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
)
(if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
(progn
(msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
(vla-quit (vlax-get-acad-object))
)
(msgbox "LOGIN NAME MANAGER" 64 "To be continue")
)
(princ)
)
@+
-
Patrick_35
Nice example. I was able to find this
http://tinyurl.com/c6nw2
but was wondering if you had the complete options list for buttons & Icon Types?
The previous two tables do not cover all values for nType. For a complete list,
see the Microsoft Win32 documentation.
-
Yes, and i find it in the ..... vba help :-D
You can see all options in http://www.w3schools.com/vbscript/func_msgbox.asp
And I profit it for post two others of the same type :lol:
(defun FileBox(/ cdl f)
;OFN_READONLY &H1 1 La case 'Lecture seule' est cochée à la création de la fenêtre.
;OFN_OVERWRITEPROMPT &H2 2 Afficher un message de confirmation d'écrasement de fichier si celui-ci existe déjà.
;OFN_HIDEREADONLY &H4 4 Case à cocher 'Lecture seule' invisible.
;OFN_NOCHANGEDIR &H8 8 Conserve le répertoire d'origine à la fermeture de la fenêtre.
;OFN_SHOWHELP &H10 16 Afficher le bouton 'Aide' dans la boîte de dialogue.
;OFN_NOVALIDATE &H100 256 Ne vérifie pas la validité de la saisie (validité du nom de fichier).
;OFN_ALLOWMULTISELECT &H200 512 Autoriser la sélection multiple de fichiers.
;OFN_EXTENSIONDIFFERENT &H400 1024 Indique que l'utilisateur a choisi une extension différente de celle par défaut.
;OFN_PATHMUSTEXIST &H800 2048 Les chemins et fichiers saisis doivent exister.
;OFN_FILEMUSTEXIST &H1000 4096 Seuls des fichiers existants peuvent être saisis.
;OFN_CREATEPROMPT &H2000 8192 Afficher une fenêtre de confirmation de création de fichier.
;OFN_SHAREAWARE &H4000 16384 Ignorer les erreurs de partage réseau.
;OFN_NOREADONLYRETURN &H8000 32768 Ne sélectionne pas la case à cocher 'Lecture seule'.
;OFN_NOTESTFILECREATE &H10000 65536 Le fichier ne sera pas créé avant la fermeture de la fenêtre.
;OFN_NONETWORKBUTTON &H20000 131072 Cache (désactive) le bouton 'Réseau'.
;OFN_NOLONGNAMES &H40000 262144 Utilise les noms courts de fichier (sans effet dans le cas des fenêtres du type 'Explorer').
;OFN_EXPLORER &H80000 524288 Donne un style 'Explorer' à la boîte de dialogue (par défaut).
; Qui ne fonctionne apparement pas sous XP
;OFN_LONGNAMES &H200000 2097152 Gestion des noms longs pour les boîtes de dialogue n'ayant pas le style 'Explorer'.
;OFN_NODEREFERENCELINKS &H100000 1048576 La boîte de dialogue prendra le nom et le chemin du raccourci sélectionné.
(setq cdl (vlax-create-object "userAccounts.CommonDialog"))
(vlax-put-property cdl 'filter (vlax-make-variant "Fichiers dessins (*.dwg)| *.dwg |Fichiers DXF (*.dwf) |Tous les fichiers (*.*)|*.*"))
(vlax-put-property cdl 'filterindex 1)
(vlax-put-property cdl 'flags (+ 4 8 512 2048 4096 131072 2097152))
(vlax-put-property cdl 'initialdir (getvar "dwgprefix"))
(if (eq (vlax-invoke cdl 'showopen) -1)
(setq f (vlax-get-property cdl 'filename))
(setq f nil)
)
(vlax-release-object she)
f
)
(defun DirBox(Message Chemin Drapeau / rep sh)
; Valeur du Drapeau
; 0 = Valeur par défaut
; 1 = BIF_RETURNONLYFSDIRS = Seulement les fichiers système
; 2 = BIF_DONTGOBELOWDOMAIN = Interdit d'explorer en dehors du domaine
; 4 = BIF_STATUSTEXT = Inclure un secteur de statut. La fonction de rappel de service peut placer le texte de statut en envoyant des messages à la zone de dialogue. Ce drapeau n'est pas soutenu quand BIF_NEWDIALOGSTYLE est indiqué.
; 8 = BIF_RETURNFSANCESTORS = Seulement les sous Dossiers
; 16 = BIF_EDITBOX = Inclure une commande d'édition dans la zone de dialogue
; 32 = BIF_VALIDATE = Verifie si l'utilisateur dactylographie un nom inadmissible dans la boîte d'édition
; 512 = BIF_NONEWFOLDERBUTTON = Ne pas inclure le bouton Créer un nouveau dossier
; 4096 = BIF_BROWSEFORCOMPUTER = Autorise à parcourir le réseau
; 8192 = BIF_BROWSEFORPRINTER = Seulement le choix d'une imprimante
; 16384 = BIF_BROWSEINCLUDEFILES = Montre tout
; = BIF_BROWSEINCLUDEURLS = Montrer les raccourcis, Les drapeaux BIF_USENEWUI et de BIF_BROWSEINCLUDEFILES doivent également être placés
; = BIF_NEWDIALOGSTYLE = Employer la nouvelle interface utilisateur
; = BIF_NOTRANSLATETARGETS = Quand l'article choisi est un raccourci, renvoyer le PIDL du raccourci lui-même plutôt que sa cible.
; = BIF_SHAREABLE = Peut montrer les ressources en commun sur les systèmes à distance. Le drapeau de BIF_NEWDIALOGSTYLE doit également être placé.
; = BIF_UAHINT = Une fois combiné avec BIF_NEWDIALOGSTYLE, ajoute un conseil d'utilisation à la zone de dialogue au lieu de la boîte d'édition. BIF_EDITBOX dépasse ce drapeau.
; = BIF_USENEWUI = Employer la nouvelle interface utilisateur, y compris une boîte d'édition
(setq sh (vlax-create-object "Shell.Application"))
(if (setq rep (vlax-invoke sh 'browseforfolder 0 Message Drapeau Chemin))
(setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
(setq rep nil)
)
(vlax-release-object sh)
rep
)
Sorry for the french help 8-) but for the function filebox, you can read http://vbcity.com/forums/faq.asp?fid=38&cat=Common+Dialog
For the function dirbox http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=375&lngWId=10
And if you want to have fun with certain functions, look at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp
@+
-
Thanks Patrick,
That's very helpful. :-)
-
Hi Patrick,
it's cool and nice,many thanks for your sample code.
Hi
(defun c:lnm(/ cnt rep)
(defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
)
(defun InputBox (Titre Message Defaut / *acad* users1 valeur)
(setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
(acad-push-dbmod)
(vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
(setq valeur (getvar "users1"))
(setvar "users1" users1)
(acad-pop-dbmod)
valeur
)
(setq cnt 0)
(while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
(setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
)
(if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
(progn
(msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
(vla-quit (vlax-get-acad-object))
)
(msgbox "LOGIN NAME MANAGER" 64 "To be continue")
)
(princ)
)
@+
-
Hi Patrick,
Your code is good,but for me,I'm not yet familiar with "WScript.Shell" ,what function that code,would you give info about that,thanks.
Hi
(defun c:lnm(/ cnt rep)
(defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
)
(defun InputBox (Titre Message Defaut / *acad* users1 valeur)
(setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
(acad-push-dbmod)
(vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
(setq valeur (getvar "users1"))
(setvar "users1" users1)
(acad-pop-dbmod)
valeur
)
(setq cnt 0)
(while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
(setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
)
(if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
(progn
(msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
(vla-quit (vlax-get-acad-object))
)
(msgbox "LOGIN NAME MANAGER" 64 "To be continue")
)
(princ)
)
@+
-
Hi,
I just got it as I want,here that code after I revised
(defun c:lnm (/ cnt len lst_str rtn str)
(setq str (dos_getstring "LOGIN NAME MANAGER" "Enter your name here"))
(if
(or (= str "Adesu")(= str "adesu"))
(progn
(alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" str))
(exit)
) ; progn
) ; if
(setq cnt 1)
(setq rtn 10)
(repeat
rtn
(if
(and (not (eq str "Adesu"))(not (eq str "adesu")))
(progn
(setq lst_str
(append lst_str
(list (dos_getstring "LOGIN NAME MANAGER" "Enter your name here"))))
(setq len (length lst_str))
(if
(= len 4)
(command "_quit")
) ; if
(setq cnt (1+ cnt))
) ; progn
) ; if
) ; repeat
(princ)
) ; defun
Hi Alls,
I just create a code to blockade a user,if that user login with not same as my name,then user put code until 5 times,the program and I want blockade or Autocad exit,I knew this code should put in acaddoc.lsp or acad2005doc.lsp,but I still got problem how to count user login until 5 times in lisp program,anyone have time to look my code,and I very apreciated for your help,thanks.
Here Lsp file
(defun c:lnm (/ ans dcl_id nam)
(setq dcl_id (load_dialog "Login Name Manager.dcl"))
(if
(not (new_dialog "lnm" dcl_id))
(exit)
)
(set_tile "eb" "Abc")
(mode_tile "eb" 2)
(action_tile "eb" "(setq nam (get_tile \"eb\"))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)(exit)")
(setq ans (start_dialog))
(if
nam
(progn
(if (= nam "")(c:lnm))
(if
(or (= nam "Adesu")(= nam "adesu"))
(progn
(alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" nam))
(exit)
) ; progn
) ; if
(if
(or (/= nam "Adesu")(/= nam "adesu"))
(c:lnm)
) ; if
) ; progn
(c:lnm)
) ; if
(princ)
) ; defun
here DCL file
// lnm is for Login Name Manager
lnm : dialog {label = "LOGIN NAME MANAGER";
: column {label = "Enter your name here";
: edit_box {key = "eb";}}
ok_cancel;}
-
Hi Adesu
With "WScript.Shell", you work with ActiveX and you can't break the dialog
With your method, is you use ctrl+break, you exit lisp
@+
-
Oh..I see,many thanks for your input.
Hi Adesu
With "WScript.Shell", you work with ActiveX and you can't break the dialog
With your method, is you use ctrl+break, you exit lisp
@+