Here's some code to play with:
Edit: Rewrote mp-wblock-ss because the vla-wblock call was "noisy" -- temporarilly showing a thumbnail preview -- so rewrote it.
mp-console-process-drawing:
(defun mp-console-process-drawing ( dwg-path script-text visible wait / acconsole folder quoted scr-path scr-handle bat-path bat-handle result )
(and
;; This function does not care what write state the passed dwg is
;; in, what script-text does, nor does it do any syntax checks etc.
;; on script-text. i.e. No sanity check's are performed -- that
;; responsibility falls on the shoulders of the caller. For example,
;; if the dwg opened was read-only because it's opened by another
;; process (accoreconsole.exe doesn't care per se and will open it)
;; and the script attempts to perform a ".qsave" without checking
;; writestat beforehand that would be kinda stupid. Bonus, depending
;; how reckless the script is, the accoreconsole.exe session may
;; never terminate. SAD. TLDR: it's the caller's responsibility to
;; use this function judiciously.
(cond
((setq acconsole (findfile "accoreconsole.exe")))
((princ "\nCan't find accoreconsole.exe, cue sad trombone.") nil)
)
(findfile dwg-path)
(setq folder (vl-filename-directory dwg-path))
(setq folder (if (wcmatch folder "*\\") folder (strcat folder "\\")))
(setq quoted (lambda (x) (strcat "\"" x "\"")))
(setq scr-path (vl-filename-mktemp "accore.scr"))
(setq scr-handle (open scr-path "w"))
(progn
(princ script-text scr-handle)
(close scr-handle)
(findfile scr-path)
)
(setq bat-path (vl-filename-mktemp "accore.bat"))
(setq bat-handle (open bat-path "w"))
(progn
(princ
(strcat
"set acconsole=" (quoted acconsole) "\n"
"set scriptname=" (quoted scr-path) "\n"
"%acconsole% /i " (quoted dwg-path) " /s %scriptname%\n"
)
bat-handle
)
(close bat-handle)
(findfile bat-path)
)
(progn
(setq shell (vlax-create-object "WScript.Shell"))
(setq result (vl-catch-all-apply 'vlax-invoke (list shell 'run bat-path (if visible 8 0) (if wait -1 0))))
(vl-catch-all-apply 'vlax-release-object (list shell))
(gc)
;; Not really definitive, only means the run request did not
;; throw an error. You may wish to code other means to
;; determine if the script achieved what you desired.
(not (vl-catch-all-error-p result))
)
)
)
mp-ss-to-array:
(defun mp-ss-to-array ( ss / i lst )
(if (and (eq 'pickset (type ss)) (< 0 (setq i (sslength ss))))
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length (repeat i (setq lst (cons (ssname ss (setq i (1- i))) lst))))))
)
(mapcar 'vlax-ename->vla-object lst)
)
)
)
mp-convert-activex-ss-to-vanilla-ss:
(defun mp-convert-activex-ss-to-vanilla-ss ( axss / vss )
(and
(eq 'vla-object (type axss))
(vlax-method-applicable-p axss 'SelectOnScreen)
(< 0 (vla-get-count axss))
;; error trapped in case maximum number of selection sets exceeded
(vl-catch-all-apply 'eval
'((progn
(setq vss (ssadd))
(vlax-for x axss (ssadd (vlax-vla-object->ename x) vss))
))
)
)
vss
)
mp-wblock-ss:
(defun mp-wblock-ss ( ss new-dwg-path / tss ss! ss-old cmdecho handle result )
(and
(cond
( (eq 'vla-object (setq tss (type ss)))
(and
(vlax-method-applicable-p ss 'SelectOnScreen)
(setq ss! (mp-convert-activex-ss-to-vanilla-ss ss))
)
)
( (and
(eq 'pickset tss)
(< 0 (sslength ss))
(setq ss! ss)
)
)
)
(setq handle (open new-dwg-path "w"))
(progn
(close handle)
(vl-file-delete new-dwg-path)
(not (findfile new-dwg-path))
)
(progn
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (setq ss-old (cadr (ssgetfirst))) (progn (setq setfirst t) (sssetfirst nil nil)))
(vl-cmdf ".wblock" new-dwg-path "" "_non" "*0,0,0" ss! "")
(if (setq result (findfile new-dwg-path)) (vl-cmdf ".oops"))
(if ss-old (sssetfirst nil ss-old))
(setvar 'cmdecho cmdecho)
)
)
result
)
Based on the generic functions above write a sample solution loosely based on your requirements:
mp-send-activess-to-new-dwg-and-process:
(defun mp-send-activess-to-new-dwg-and-process ( / ss new-dwg-path my-script result )
(and
(cond
( (setq ss (cadr (ssgetfirst)))
(cond
((zerop (sslength ss)) (princ "\nActive selection set is empty; SAD.") nil)
(t)
)
)
( (princ "\nNo active selection set, SAD.") nil)
)
;; It ain't pool.dwg, then again this code is free ;p
(setq new-dwg-path (vl-filename-mktemp "vogon.dwg"))
(mp-wblock-ss ss new-dwg-path)
(setq my-script
(strcat
;; Note: Can't use any activex calls in accoreconsole.exe.
"(command \".layer\" \"_color\" 7 \"*\" \"_unlock\" \"*\" \"\")\n"
"(if (setq ss (ssget \"x\"))\n"
" (repeat (setq i (sslength ss))\n"
" (vl-catch-all-apply 'eval\n"
" '( (entmod\n"
" (subst\n"
" '(62 . 7)\n"
" (assoc 62 (setq data (entget (ssname ss (setq i (1- i))))))\n"
" data\n"
" )\n"
" )\n"
" )\n"
" )\n"
" )\n"
")\n"
"(if (eq 1 (getvar 'writestat))\n"
" (progn\n"
" (setvar 'expert 5)\n"
" (command \".saveas\" \"2007\" (strcat (getvar 'dwgprefix) (getvar 'dwgname)))\n"
" )\n"
")\n"
"(if (< 0 (getvar 'dbmod))\n"
" (command \".close\" \"_yes\")\n"
" (command \".close\")\n"
")\n" ;; last carriage return is important
)
)
(mp-console-process-drawing
new-dwg-path
my-script
nil ;; don't show accoreconsole.exe working
t ;; wait | work synchonously
)
)
(princ
(cond
((null new-dwg-path) "")
((setq result (findfile new-dwg-path)) (strcat "\nCreated: " result))
("\nUnexpected error in module 'deep thought'.")
)
)
(princ)
)
Run our custom solution:
(mp-send-activess-to-new-dwg-and-process)
Sample output if successful:
Created: C:\Users\Arthur Dent\Temp\vogon042.dwg