Purge for reactor + Reactor close to Reactor delete

Purge for reactor + Reactor close to Reactor delete

Anonymous
Not applicable
1,303 Views
5 Replies
Message 1 of 6

Purge for reactor + Reactor close to Reactor delete

Anonymous
Not applicable

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)
;;=======================================================================

 

0 Likes
Accepted solutions (1)
1,304 Views
5 Replies
Replies (5)
Message 2 of 6

hmsilva
Mentor
Mentor
Accepted solution

Hi Dieter,

 

perhaps something like this

[untested]

(foreach x OldList
  (if (vl-position x Removelist)
    (progn
      (Alert (strcat "You deleted block " x ", This has been removed from the settings."))
      (vlax-for y (vla-get-blocks Activedoc)
        (if (and (= (vla-get-objectname y) "AcDbBlockTableRecord")
                 (= (strcase (vla-get-name y)) (strcase x))
            )
          (vla-delete y)
        )
      )
    )
    (write-line (strcat x) file)
  );if
);foreach

 

Hope this helps,
Henrique

EESignature

Message 3 of 6

Anonymous
Not applicable

Works fine, one question, i see you changed member to vl-position, is that for a reason? faster processing?

 

Also, you got some examples of a reactor issued when activated a command ,most precisely a erase command?

 

Thanks Henrique, flawless as always. 

0 Likes
Message 4 of 6

hmsilva
Mentor
Mentor

You're welcome, Dieter!


'i see you changed member to vl-position, is that for a reason? faster processing?'

 

Yes, with member, returns the remainder of the list, with vl-position, just returns the index of the specified list item, it's much faster.

 

'Also, you got some examples of a reactor issued when activated a command ,most precisely a erase command?'

 

I don't have AutoCAD in this laptop, but if you do a search in 'Search This Board' for reactors, you will find several examples.

 

This Reinaldo Togores's post may be useful to understand reactors.

 

Hope this helps,
Henrique

EESignature

0 Likes
Message 5 of 6

Anonymous
Not applicable

thanks Henrique,

 

that's my lecture for this evenings it seems. 

Another question popped up into my mind, is there a way to audit in a reactor? 

 

thanks.

0 Likes
Message 6 of 6

hmsilva
Mentor
Mentor

Subje wrote:

Another question popped up into my mind, is there a way to audit in a reactor? 


You're welcome, Dieter.

 

If you are using AutoCAD 2015, possibly...

In AutoCAD 2015, there is a Audit API, in dotNET and ????, I was trying to find the site I read about it, unsuccessfully...

Try to google for 'Audit API', possibly you will find it.

Henrique

EESignature

0 Likes