[转贴]：DSX AutoLayer

eachy · 发表于 2003-7-25 12:56:42

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;*********************************************************
;;;*********************************************************
(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|;

;;;********************************************************* 
;;;********************************************************* 
(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|;

bsq · 发表于 2004-5-14 09:18:25

请问斑竹，这如何使用？

luoyaya · 发表于 2004-5-15 12:55:03

VLR-MANAGER函数不存在~~~!!!???

64342759 · 发表于 2004-5-15 15:55:55

我看不懂,能说明白点吗,

bsq · 发表于 2004-5-16 21:16:03

请问如果我不想安装DSX，能单独用上面的程序吗？

fundoll · 发表于 2004-5-28 08:39:21

好多函数不全，请版主再看看。

Underway · 发表于 2005-10-22 17:48:46

AutoLay[3.0].zip
分享者(原作者)
Eric Schneider eschneider@spamfree.jensenprecast.com

2002年11月21日 09:08 分享于
autodesk.autocad.customer-files

账号		自动登录	找回密码
密码			立即注册

[转贴]：DSX AutoLayer

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子