- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
So i tried my first reactor, a copy past story :p. and then i put my function in it.
It works fine but one thing i still missing, and thats a purge from a specific block, I already learned that a command purge can't be excuted in a reactor and that there is a purgeall. But is it possible without a purgeall, and like purge the block (green text)..
Also i m running this reactor at a close command, but i would be problaby better if i run it with a certain command like a delete command.
if you need more informatie, the reactor looks into 2 textfiles (one with all titleblocks in a project) (and one with all titleblocks in that drawing) . It checks of there all blocks equal to that textfile still exist, and if not, it adjust the 2 textfiles...
also it works with another textfile where it asking the projectnumber if not created.
;;=======================================================================
;; CLOSE reactor
;;=======================================================================
(vl-load-com)
(defun smart-command-reactor (commands StartCallback EndCallback / ended)
(vl-load-reactors)
(setq ended
(vlr-command-reactor nil
'(
(:vlr-commandEnded . internal-commandEnded)
(:vlr-commandCancelled . internal-commandEnded)
(:vlr-commandFailed . internal-commandEnded)
)
)
)
(vlr-remove ended)
(vlr-command-reactor
(list
ended
StartCallback
EndCallback
(if (listp commands)
(mapcar 'strcase commands)
(list (strcase commands))
)
)
'((:vlr-commandWillStart . internal-commandWillStart))
)
)
;;=======================================================================
(defun internal-commandWillStart (reactor args / data result)
(setq data (vlr-data reactor))
(if
(and
(member (car args) (last data))
(setq result (apply (cadr data) (list (car args))))
)
(progn
(vlr-data-set
(car data)
(list (caddr data) result)
)
(vlr-add (car data))
)
)
)
;;=======================================================================
(defun internal-commandEnded (reactor args / data)
(setq data (vlr-data reactor))
(vlr-remove reactor)
(apply
(car data)
(list
reactor
(vlr-current-reaction-name)
(car args)
(cadr data)
)
)
)
;;=======================================================================
(if *my-smart-close-reactor* (vlr-remove *my-smart-close-reactor*))
;;=======================================================================
(setq *my-smart-close-reactor*
(smart-command-reactor
;; command(s) as list
'("CLOSE")
;; StartCallback (called when CLOSE starts)
(function
(lambda (cmdname)
;;;===================================================
;;; *** from here
;;;===================================================
;;; (vla-ZoomExtents (vlax-get-acad-object))
(setq Listtxt nil)
(setq Newlist nil)
(setq Removelist nil)
(setq OldList nil)
(setq DWGprefix (getvar "dwgprefix")
Externfolder (strcat DWGprefix "\\#Library-Do Not Edit#")
Localfolder (strcat "C:\\Autodesk-library")
DWGprefixL (strlen DWGprefix)
Last4letters (substr DWGprefix (- DWGprefixL 4) 4)
DWGname (getvar "dwgname")
DWGnameL (strlen DWGname)
DWGname (substr DWGname 1 (- DWGnameL 4))
BlockUsed (strcat Externfolder "\\BinTitleBlock.txt")
TxtForDwgTitleblock (strcat Externfolder "\\Bin"DWGname"Titleblock.txt")
project (strcat Externfolder "\\BinProjectBlock.txt")
Activedoc (vla-get-activedocument (vlax-get-acad-object)))
(if (not(vl-file-directory-p Localfolder))
(vl-mkdir Localfolder)
)
(if (eq Last4letters "ACAD")
(progn
(if (not (open project "R"))
(progn
(if(not(setq dcl_id (load_dialog "PROJECTNUMBER.dcl")))
(progn
(alert "The DCL file could not be loaded!")
(exit)
);PROGN
(progn
;;;--- Load the definition inside the DCL file
(if (not(new_dialog "PROJECTNUMBER" dcl_id))
(progn
(alert "The DOSSIER definition could not be loaded!")
(exit)
);PROGN
(progn
(action_tile "DOSSIERNUMMER" "(setq Projectnumber $value)")
(start_dialog)
(unload_dialog dcl_id)
(setq file (open project "W"))
(write-line (strcat Projectnumber) file)
(close file)
)
)
)
)
)
(progn
(setq file (open project "R"))
(setq Projectnumber (read-line file))
(close file)
)
)
(if
(not(vl-file-directory-p Externfolder))
(vl-mkdir Externfolder)
)
(if
(open TxtForDwgTitleblock "r")
(progn; first argument 1.1.1
(setq file (open TxtForDwgTitleblock "R"))
(while (setq Txtline (read-line file))
(setq Listtxt (cons Txtline Listtxt)))
(close file)
(setq Listtxt (reverse Listtxt))
)
(setq Listtxt nil)
)
(if
(not(eq Listtxt nil))
(progn
(foreach x Listtxt
(setq ListX x)
(if (and
(not (eq (tblsearch "block" ListX) nil))
(ssget "_X" '((0 . "INSERT")(66 . 1)))
)
(vlax-for block (vla-get-ActiveSelectionSet Activedoc)
(if
(= (strcase (vlax-get-property block 'EffectiveName)) (strcase ListX))
(progn
(setq Newlist (cons ListX Newlist))
);Progn
)
)
)
)
)
)
(princ Newlist)
(foreach x Listtxt
(setq ListtxtX x)
(if (not(member ListtxtX Newlist))
(setq Removelist (cons ListtxtX Removelist))
)
)
(princ Removelist)
(setq file (open TxtForDwgTitleblock "W"))
(close file)
(setq Start (vl-string-search (strcat "\\" "\\") (strcat TxtForDwgTitleblock)))
(if (not (eq Newlist nil))
(progn
(setq Newlist (Reverse Newlist))
(foreach x Newlist
(setq file (open TxtForDwgTitleblock "A"))
(write-line (strcat x) file)
(close file)
)
)
)
(if (not (eq Removelist nil))
(progn
(if
(open BlockUsed "R")
(progn
(setq file (open BlockUsed "R"))
(while (setq Txtline (read-line file))
(setq OldList (cons Txtline OldList)))
(close file)
(setq OldList (reverse OldList))
(setq file (open BlockUsed "W"))
(foreach x OldList
(setq OldListX x)
(if (member OldListX Removelist)
(progn
(Alert (strcat "You deleted block " OldListX ", This has been removed from the settings."))
;;; (COMMAND "_purge" "BLocks" OldListX "_N")
)
(progn
(write-line (strcat OldListX) file)
)
);if
);foreach
(close file)
);progn
)
)
)
);progn
)
(setq Listtxt nil)
(setq Newlist nil)
(setq Removelist nil)
(setq OldList nil)
;;; (alert "Command CLOSE was issued.")
;;;===================================================
;;; *** to here
;;;===================================================
)
)
;; EndCallback (called when CLOSE ends)
(function
(lambda (data)
(setvars data)
(sssetfirst nil)
(setq app nil adoc nil)
)
)
)
)
;;=======================================================================
(defun setvars (data)
(mapcar
(function
(lambda (v / r)
(setq r (getvar (car v)))
(setvar (car v) (cdr v))
(cons (car v) r)
)
)
data
)
)
;;=======================================================================
(princ "\nCLOSE reactor enabled.")
;;=======================================================================
(princ)
;;=======================================================================
Solved! Go to Solution.