OpenDCL Project Fast Dump · OpenDCL Forums Archive

Slavko.Ivanovic 2009-11-14 03:49 UTC

i needed something like this, so i write it.

dump data peview.
{2}

~~initial version~~.
~~List of events is Case Sensitive, and i copied from Opendcl Help, and find 3-4 that are wrong and correct them , but maybe some more.~~

~~(changed - posted ver. 02)~~

(changed - posted ver. 0.2b)

.lsp is in attachment but here is the code.

;;|*****|==================================================================================================================
;; used (si-xt) library functions (accessories)
(OR *lastdir* (SETQ *lastdir* ""))
;;-------------------
(DEFUN SI-FILE-OPEN ( / ~t)
(SETQ ~t (GETFILED *lastdir* 8))
(IF ~t
(PROGN (SETQ *lastdir* (STRCAT (VL-STRING-RIGHT-TRIM "\\" (VL-FILENAME-DIRECTORY (SETQ ~t (FINDFILE ~t)))) "\\"))
)
)
~t
)
;;-------------------
(DEFUN SI-FILE-SAVEAS ( / ~t)
(SETQ ~t (GETFILED *lastdir* 1))
(IF ~t
(PROGN (SETQ *lastdir* (STRCAT (VL-STRING-RIGHT-TRIM "\\" (VL-FILENAME-DIRECTORY ~t)) "\\")))
)
~t
)
;;-------------------
(DEFUN SI-LST-CLEARDUPLICATES ( / ~lst ~t)
(FOREACH
~t
(IF (NOT (MEMBER ~t ~lst))
(SETQ ~lst (CONS ~t ~lst))
)
)
(REVERSE ~lst)
)
;;-------------------
(DEFUN SI-LST-GETSAMEMEMBERS ( / ~lst ~t)
(IF (OR )
(PROGN (FOREACH
~t
(IF (MEMBER (STRCASE ~t) )
(SETQ ~lst (CONS ~t ~lst))
)
)
)
)
(SETQ ~lst (REVERSE ~lst))
(SI-LST-CLEARDUPLICATES ~lst)
)
;;-------------------
(DEFUN SI-UTL-GETSTRING ( / ~t)
(PRINC (STRCAT "\n" " <" ">: "))
(SETQ ~t (VL-CATCH-ALL-APPLY 'GETSTRING (LIST T)))
(IF (VL-CATCH-ALL-ERROR-P ~t)
(SETQ ~t nil)
)
(IF (/= ~t "")
~t

)
)
;;-------------------
(DEFUN SI-UTL-GETKWORD ( / ~t)
(SETQ ~t (VL-CATCH-ALL-APPLY 'GETKWORD (LIST (STRCAT "\n" ))))
(IF (VL-CATCH-ALL-ERROR-P ~t)
(SETQ ~t nil)
~t
)
)
;;-------------------
(DEFUN SI-GET-DATETODAY (/ ~s)
(SETQ ~s (RTOS (GETVAR "CDATE") 2))
(STRCAT (SUBSTR ~s 7 2) "." (SUBSTR ~s 5 2) "." (SUBSTR ~s 3 2))
)
;;-------------------
(DEFUN SI-GET-TIMENOW (/ ~s)
(SETQ ~s (GETVAR "CDATE")
~s (SUBSTR (RTOS (- ~s (FIX ~s)) 2 8) 3)
)
(STRCAT (SUBSTR ~s 1 2) ":" (SUBSTR ~s 3 2) ":" (STRCAT (SUBSTR ~s 5 2)))
)
;;|*****|==================================================================================================================

;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| *** OpenDCL Project Fast Dump by Slavko Ivanovic *** ||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| ver. 0.2b |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| 14. November 09 |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| - added option for quick look using write to temp file |||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| - added time stamp |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| ver. 0.2 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| 14. November 09 |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| - added STR CASE control (by Fred Tomke, -kep-digital.de) ||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| - added dcl (DCL_PROJECT_LOAD ~pr T) T flag for reloading ||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| - added two separ. lines in (dump-to-file) better when dumping in same .txt ||||||||||||||||||||||
;;|||||||||||| ver. 0.1 (initial )||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;|||||||||||| 14. November 09 |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

(DEFUN C:OPD (/ ~all-events ~error-prompts ~e ~load ~pr ~project ~password ~allforms ~collectall ~dumpfile ~file)
;;
;;
;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;; load shi*t up
(SETQ ~all-events
(MAPCAR 'STRCASE
(LIST ;
"BeginLabelEdit" "BeginLabelEdit" "BeginLabelEdit" "ButtonClicked" "Cancel"
"CancelClose" "Changed" "Clicked" "Close" "ColumnClick"
"DblClicked" "DblClicked" "DblClicked" "DeleteItem" "DocActivated"
"DragnDropBegin" "DragnDropFromControl" "DragnDropFromOther"
"DragnDropToAutoCAD" "DropDown" "EditChanged" "EndLabelEdit"
"EndLabelEdit" "EndLabelEdit" "EnteringNoDocState" "FolderChanged"
"GetDayState" "Help" "INITIALIZE" "ItemExpanded" "ItemExpanding"
"KeyDown" "KeyUp" "KillFocus" "MaxText" "MouseDblClick"
"MouseDown" "MouseEntered" "MouseMove" "MouseMovedOff" "MouseUp"
"MouseWheel" "NavigationComplete" "OK" "OptionsApply"
"OptionsCancel" "OptionsHelp" "OptionsOk" "Paint" "RightClick"
"RightDblClick" "ReleasedCapture" "ReturnPressed" "Scroll" "Scrolled"
"SelChanged" "SelChanged" "SelChanged" "SelChanged" "SelChanging"
"Select" "SetFocus" "Show" "Size" "SplitterMove"
"TypeChanged" "Update"
)
)
~error-prompts
(LIST "OpenDCL arx not loaded!" "Project Load canceled!"
"OpenDCL project not loaded!" "Command canceled!"
"OpenDCL project password not correct!" "Problem collecting data!"
"Dump saving canceled!"
)
~funcs
(LIST
;;|||||||||||||||||||
(DEFUN get-all-forms ()
(IF (EQ ~password "ENTER for None")
(DCL_PROJECT_GETFORMS ~project)
(DCL_PROJECT_GETFORMS ~project ~password)
)
)
;;|||||||||||||||||||
(DEFUN property-available-p (~o ~p) (MEMBER ~p (DCL_CONTROL_GETPROPERTIES ~o)))
;;|||||||||||||||||||
(DEFUN filter-named-controls (~ctrlst)
(VL-REMOVE
nil
(MAPCAR '(LAMBDA (x)
(IF (property-available-p x "(Name)")
x
)
)
~ctrlst
)
)
)
;;|||||||||||||||||||
(DEFUN getname (~ctrl) (DCL_CONTROL_GETPROPERTY ~ctrl "(Name)"))
;;|||||||||||||||||||
(DEFUN get-events (~f)
(VL-REMOVE
nil
(MAPCAR '(LAMBDA (x)
(LIST (getname x)
(MAPCAR '(LAMBDA (p)
(IF (= (DCL_CONTROL_GETPROPERTY x p) "")
nil
p
)
)
(SI-LST-GETSAMEMEMBERS (DCL_CONTROL_GETPROPERTIES x) ~all-events)
)
)
)
~f
)
)
)
;;|||||||||||||||||||
(DEFUN multitab (~stl)
(MAPCAR '(LAMBDA (x)
(IF (= (TYPE x) 'STR)
(STRCAT "\t\t\t\t\t" x)
)
)
~stl
)
)
;;|||||||||||||||||||
(DEFUN stampgen ()
(STRCAT "\nDate: "
(SI-GET-DATETODAY)
" Time: "
(SI-GET-TIMENOW)
"\nProject "
~pr
"\nOpenDCL ["
(DCL_GETVERSIONEX)
"] on ACAD "
(GETVAR "acadver")
" "
(GETVAR "_vernum")
)
)
;;|||||||||||||||||||
(DEFUN fap (~s / ~f)
(SETQ ~f (OPEN ~file "a"))
(IF (= (TYPE ~s) 'STR)
(WRITE-LINE ~s ~f)
(FOREACH
@st ~s
(IF (= (TYPE @st) 'STR)
(WRITE-LINE @st ~f)
)
)
)
(CLOSE ~f)
~s
)
;;|||||||||||||||||||
(DEFUN dump-to-file ()
(fap (LIST "\n**********************************************************************"
"*** OpenDCL Project Fast Dump by Slavko Ivanovic *** ...dump start"
"--------------------------------------------------"
(stampgen)
"=================================================="
"Forms\t\tControls\t\tEvents/On"
"=================================================="
)
)
(MAPCAR '(LAMBDA (x)
(LIST (fap "--------------------------------------------------")
(fap (STRCAT "" (CAAAR x)))
(fap (multitab (CADAAR x)))
(MAPCAR '(LAMBDA (c) (LIST (fap (STRCAT "\t\t" (CAR c))) (fap (multitab (CADR c))))) (CADR x))
)
)
~collectall
)
(fap (LIST "\n--------------------------------------------------"
"*** OpenDCL Project Fast Dump by Slavko Ivanovic *** ...dump end"
"**********************************************************************\n"
)
)
)
;;|||||||||||||||||||
(DEFUN clearsyms (~symlst)
(SETQ ~syl (VL-SYMBOL-VALUE ~symlst))
(LENGTH (MAPCAR '(LAMBDA (x) (SET x nil)) (CONS ~symlst ~syl)))
)
)
)
;; load shi*t end
;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;
;;
;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;; main start
(OR (AND (SETQ ~e 0
~load (VL-CMDF "OpenDCL")
)
(SETQ ~e 1
~pr (SI-FILE-OPEN "Select OpenDCL Project file" "odcl")
)
(SETQ ~e 2
~project
(DCL_PROJECT_LOAD ~pr T)
)
(SETQ ~e 3
~password
(SI-UTL-GETSTRING "Password?: " "ENTER for None")
)
(SETQ ~e 4
~allforms
(filter-named-controls (get-all-forms))
)
(SETQ ~e 5
~collectall
(MAPCAR '(LAMBDA (x) (LIST (get-events (LIST x)) (get-events (DCL_FORM_GETCONTROLS x)))) ~allforms)
)
(PROGN (INITGET 1 "Save Temp")
(SETQ ~e 6
~file (SI-UTL-GETKWORD "Save dump file or temporary? (Save or Temp): ")
)
)
(SETQ ~file (IF (EQ ~file "Save")
(SI-FILE-SAVEAS "Save OpenDCL Project Dump file" "txt")
(VL-FILENAME-MKTEMP "dump.txt")
)
)
(PROGN (dump-to-file) (STARTAPP "NOTEPAD.exe" ~file))
)
(PRINC (STRCAT "\n * Oops, " (NTH ~e ~error-prompts)))
)
;; main end
;;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;;
;;
;; kill shi*t & out
(clearsyms '~funcs)
(PROMPT "\n © Slavko Ivanovic, -SlavkoSolutions.com")
(PRINC)
)

;; note loaded
(PROMPT "\n*** OpenDCL Project Fast Dump v.0.2b loaded.")
(PROMPT "\n*** type OPD [>>enter] to try this")
(PROMPT "\n*** © Slavko Ivanovic, -SlavkoSolutions.com")

;|«Visual LISP© Format Options»
(120 1 43 2 nil "-->" 100 6 2 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;

just feel like sharing.
use if u like it

Slavko

Attachments

OPD_v0.2_b.LSP (12102 bytes)

fred_tomke 2009-11-14 06:17 UTC

Hi, Slavko, I'm deeply impressed by your code. I added altered code to avoid that event names must be case sensitive (see Initialize in uppercases in the code).

Great job! This should be part of the OpenDCL samples.

Fred

Attachments

OPD.LSP (9725 bytes)

Slavko.Ivanovic 2009-11-14 11:57 UTC

Thanks Fred.
When this type of comment comes from you, its "strong" for me, cause i was impressed by your code more than once.
I like your coding style and ideas.

I updated my post above, and change attachment to updated v02.lsp.
I added two small things too.

comment to code:
- usualy i use function like (clearsyms ~symlst) only for OpenDCL event functions lists (unique symbols).
In this case maybe is better to localize func names, but i leave this to user to do if get in conflict with namspace symbols.
- usualy i put some kind of error handling, but for this purpose (diagnostic) i don't think is necessary .

Slavko

Kerry Brown 2009-11-14 13:02 UTC

Slavko,

Very nice functionality. Great example.

Thanks
Regards
Kerry

owenwengerd 2009-11-15 05:08 UTC

Another approach to this would be to capture and parse the output of (dcl_project_dump).

Slavko.Ivanovic 2009-11-15 12:30 UTC

author=owenwengerd link=topic=1011.msg5163#msg5163 date=1258261715 wrote:
Another approach to this would be to capture and parse the output of (dcl_project_dump).

That was the first approach that cross my mind when i started to think to write this, but (at least for me),
this will be far more complicated and probably less precise (i prefer working with lists).

Anyway, this is all i wanted.

Slavko