2007年6月30日 星期六

[轉貼]:DSX AutoLayer

;;*********************************************************
;;;*********************************************************
(vl-load-com)
(defun get-item (collection item / result)
(cond
((not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
result
)
)
)
(setq oAcad (vlax-get-acad-object) ; acadapplication object
oDoc (vla-get-activedocument oAcad) ; activedocument object
oLay (vla-get-layers oDoc) ; layers collection of activedocument
)
(defun rCmdLayer (reactor data / cmd)
(setq cmd (strcase (car data))) ; get command name
(cond
((wcmatch cmd "*HATCH") ;is the command "*hatch"?
(rCmdLayer-Setlayer "HATCH")
)
)
)
(defun rCmdLayer-SetLayer (name / lay)
(cond
((setq lay (get-item oLay name))
(if (= :vlax-True (vla-get-lock lay))
(progn
(setq $laylock :vlax-True)
(vla-put-lock lay :vlax-False)
)
)
(if (= :vlax-False
(vla-get-layeron lay)
(progn
(setq $layon :vlax-false)
(vla-put-layeron lay :vlax-true)
)
)
(if (= :vlax-True (vla-get-Freeze lay))
(progn
(setq $layfrz :vlax-true)
(vla-put-Freeze layobj :vlax-false)
)
)
(vla-put-activelayer aDoc lay)
)
)
)
)
(defun rCmdLayer-Restore (reactor data / data lay)
(setq cmd (strcase (car data))) ; get command name
)
;;;upon completion of command restores *layers* to previous state
(defun al:restore (reactor info / cmd layobj)
(setq cmd (car info))
(if
(and
*capslock*
(or
(wcmatch (strcase cmd)
"*LEADER,*QLEADER,*MTEXT,*TEXT,*DDEDIT,*ATTEDIT"
)
(and
(wcmatch
(strcase cmd)
"*DIM,*DIMLINEAR,*DIMALIGNED,*DIMORDINATE,*DIMRADIUS,*DIMDIAMETER,*DIMANGULAR,*DIMBASELINE,*DIMCONTINUE,*QDIM,*LEADER,*QLEADER,*MTEXT,*TEXT,*DDEDIT"
)
(= (vlax-variant-value (vla-getvariable *adocobj* "dimaso"))
0
)
)
)
)
(dos_capslock)
)
(if (< (vlax-variant-value (vla-getvariable *adocobj* "cmdactive"))
2
) ;test for transparent commands
(progn
(setq layobj (vla-get-ActiveLayer *adocobj*))
;get ActiveLayer object
(if offlay ; "hidden" layer noted as off (offlay not nil)
(vlax-put-property
(vla-item *layers*
(if (wcmatch (strcase (car info)) "*HATCH")
"Hidden"
"Hatch"
)
)
"LayerOn"
1
) ;turn "hidden" layer back on
) ;end if
(if
(and
clobj ; clayer objobject assigned to clobj in al:laystate (clobj not nil)
(not (equal clobj layobj)) ;if clayer object (clobj set in al:laystate) layer object
) ;end and
(vla-put-ActiveLayer *adocobj* clobj) ;sets layer current
) ;end if
(if layoff ; if the layer (layoff set in al:laystate) was noted as off (layoff not nil)
(vla-put-LayerOn layoff 0) ;turn it off again
) ;end if
(if layfreeze ; if layer (layfreeze set in al:laystate) was frozen (layfreeze not nil)
(vla-put-Freeze layfreeze 1) ;freeze it again
) ;end if
(if laylock ; if layer (laylock set in al:laystate) was locked (laylock not nil)
(vla-put-Lock laylock 1) ;Lock it again
) ;end if
(setq clobj nil
offlay nil
layoff nil
layfreeze nil
laylock nil
) ;set global variables to nil
) ;end progn
) ;end if
) ;end defun

;;;======================================================================
;;;disables commandEnded reactor to avoid errors when using "new" and "open"
;;;in SDI mode. The error is merely annoying and only appears at the command
;;;line as "error: no function definition: al:restore" when opening or creating
;;;a new drawing. The cause of the error is commandEnded reactor present form
;;;last dwg but LISP has not yet loaded the called function in a new or opened
;;;dwg. Furthermore, the reactor cannot be removed because it has already been
;;;activated and is waiting for the command to end. Therefore, the reactor must
;;;be rendered non-functional by changing its call to the LISP command "LIST".
(defun al:disable (reactor info / tdat)
(if
(= (vlax-variant-value (vla-getvariable *adocobj* "sdi")) 1)
;in SDI mode?
(vlr-reaction-set
(car (vlr-object
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . al:restore)
(:VLR-commandCancelled . al:restore)
)
)
)
)
:VLR-commandEnded
'list
)
) ;end if
) ;end defun

;;;======================================================================
;;;Here's where we set up the reactors to do all this cool stuff
(vlr-set-notification
(vlr-manager
'(VLR-DWG-reactor nil '((:VLR-beginClose . al:disable)))
3
)
'active-document-only
)
(vlr-set-notification
(vlr-manager
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . al:restore)
(:VLR-commandCancelled . al:restore)
)
)
3
)
'active-document-only
)


;;;======================================================================
;;;get rid of old reactor if present. The reactor will be present, because in
;;;SDI mode, it's associated namespace is not destroyed, but has the new drawing
;;;loaded into it. At the time this file is loaded, this reactor is either not
;;;present or has been rendered useless (in SDI mode) at the closing of the last
;;;dwg and is excess loaded code bulk and should be removed. The VLR-MANAGER
;;;provides an easy means of doing this.
(vlr-manager
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . list)
(:VLR-commandCancelled . al:restore)
)
)
1
)
;;;======================================================================
(princ
"\nAutoLay V2.2 loaded. Type \"autolay\" or \"capslock\" to enable/disable."
)
(princ)

;;;======================================================================
;
Set up and installation instructions:
This is kind of an outline of the things you may need to edit to make this program work with your companies drafting standards.

The main body of autolay has the conditions that must be tested for to see if a layer needs to be switched to or created. It is also
where the layer name comes from. (al:laystate "Hatch" cmd) is the first such command (noted as cond 1) in the code to create or
switch to a layer, where "Hatch" is to be the actual name of the layer to be created. The conditions will probably be the most
difficult part to adapt to your companies drafting standards. Lets take a look at cond 6 for example:

(;cond 5
(wcmatch cmd "*TEXT");are you creating text?
(al:laystate "Text" cmd);make, thaw, turn on and make current "Text" layer as needed
);end cond 5

If the command (cmd) is "*text", then create or switch to a layer named "Text". You can have as many conds and *layers* as you
need. You can also add other parameters such as text style and/or size in different CONDS to put different text styles or sizes
on different *layers*. That would then look more like:

(;cond 6
(and
(wcmatch cmd "*TEXT");are you creating text?
(wcmatch tst "~SIMPLEX");is the current text style NOT "Simplex"*
(= tsz (* (getvar "dimscale") 0.0625));is this the current text size?
);end and
(al:laystate "Text" cmd);make, thaw, turn on and make current "Text" layer as needed
);end cond 6

The routine al:ltype is the one that decides what linetype is assigned to a layer (name). Similar is true for al:lweight and al:color.
Edit these to suit your companies drafting standards.

One more thing. If you use a different linetype source file (.lin file format) other than acad.lin or acadiso.lin, you will
have to edit in the name of the linetype file name in the al:mkLay routine.

To disable AutoLay[2.2].lsp, type "autolay" at the commond prompt.

This should be enough to get you going. Pick away, play around with it and learn from it until you get it to do what you want. I
already did the hard part of coding and testing.

Best Regards
Eric Schneider;


轉貼:http://publishblog.blogchina.com/blog/tb.b?diaryID=5753822

沒有留言: