ASD - Reactor interrups.

ASD - Reactor interrups.

Anonymous
Not applicable
415 Views
2 Replies
Message 1 of 3

ASD - Reactor interrups.

Anonymous
Not applicable

Hi all,

 

i have a "close" reactor in AUTOCAD 2015. Works fine. Now i m trying ASD but i got a interrup. 

 

Code is below, If i check the interrup he stops at alert 2 , don't alert 3,  and  sits in a loop or something like that after alert 2. i can break it with a escape but with ASD i get a popup for close then.

 

1 ->>>>  So we can either way try to "unload that reactor" or

2 ->>>>  try to adjust that reactor to ASD ways. maybe change the part between alert 2-3 (that's the hard part because i really have no idea why he stops). Instead of AUTOCAD the close Command of ASD is always with a pop-updialog (do you want to save changes) even if you save just before close. Also Filedia has no effect on that dialog. 

3 ->>>>   or maybe a thirt option is to override or make a second close command and try to build it myself. without pop up. maybe i can import the one from AUTOCAD and set as second? Not sure if it's possible. 

 

Any thoughts on this would be handy, so fire away :D. as far as my knowledge go, reactors isn't a part of it. 

 

 

Command: *Cancel*
Command: *Cancel*
Command: _close ; entering keyboard break loop
; entering keyboard break loop
Automatic save to C:\Users\dieter.bevernage\appdata\local\temp\5107_Noir Fontaine Hall 2_Kolommen2(test)_1_1_3053.sv$ ...
Command:

 

;;=======================================================================
;; CLOSE reactor Tony Tanzillo + Edit:text function Dieter Bevernage     
;;=======================================================================
(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
	  (vl-file-directory-p Externfolder)
	  (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)
		)
	      )
	    (ALERT "1")
			    

	    (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)
	      )
	    (Alert "2")
	    (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));;;;;;;Maybe it ;;;;;;;;;;;;;;has to do with this?
			(progn
			  (setq Newlist (cons ListX Newlist))
			  );Progn

			)
		      )
		    )
		  )
		)
	      )

	    (ALERT "3")
	    
	    (foreach x Listtxt
	      (setq ListtxtX x)
	      (if (not(member ListtxtX Newlist))
		(setq Removelist (cons ListtxtX 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 (vl-position OldListX Removelist)
			(progn
			  (Alert (strcat "You deleted block " OldListX ", 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)
			      )
			    )

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

 

 

 

...............
LOG Trace stack
...............
<1> :KBD-BREAK
<2> :TOP-COMMAND
<3> :KBD-BREAK
<4> :TOP-COMMAND
<5> :KBD-BREAK
[6] (VLAX-FOR ...)
[7] (FOREACH ...)
[8] (#<USUBR @000000004cf4e3e0 -lambda-> "CLOSE")
[9] (APPLY (quote #<USUBR @000000004cf4e3e0 -lambda->) ("CLOSE"))
[10] (INTERNAL-COMMANDWILLSTART #<VLR-Command-Reactor> ("CLOSE"))
<11> :CALLBACK-ENTRY
<12> :REACTOR-CALLBACK
...............
 
...............

 

0 Likes
416 Views
2 Replies
Replies (2)
Message 2 of 3

Anonymous
Not applicable

Although, if i recall,

 

3->>>> ASD is a structural program with is adding elements, so that means, if we change the close command, (there must be a reason why they changed the close command) , that we maybe lose intelligence of those objects. so i can conclude that overwriting the close command maybe harm ASD-ways. 

 

 

So only option 2 and 1 is available. 

 

I m now gonna test option 1 by deleting the reactor and see if i can get something else running. 

 

any thoughts on option 2 would be welcome. 

 

 

0 Likes
Message 3 of 3

hmsilva
Mentor
Mentor

Hi Dieter,

 

I do not deal with reactors for a long time, but if I remember correctly, we can't use 'ssget' inside a reactor call-back from ':vlr-commandWillStart'...

Try to use only the Layouts Collection and Blocks Collection to search for Blocks with Attributes, and add to the 'Newlist' the 'EffectiveName' property.

i.e.

(vlax-for layt (vla-get-layouts Activedoc)
  (vlax-for blk (vla-get-block layt)
    (if
      (and (= (vla-get-objectname blk) "AcDbBlockReference")
           (= (vla-get-hasattributes blk) :vlax-true)
           (= (strcase (vlax-get-property
                         blk
                         (if (vlax-property-available-p blk 'EffectiveName)
                           'EffectiveName
                           'Name
                         )
                       )
              )
              (strcase ListX)
           )
      )
       (setq Newlist (cons ListX Newlist))
    )
  )
)

 

 

Hope this helps,
Henrique

 

EESignature

0 Likes