citykunan 发表于 2005-1-13 09:51:00

是啊,我通常只上明经,也只有明经的积分,龙版主能不能帮我粘过来,或者发一个到我的信箱。谢谢。

e2002 发表于 2005-1-13 13:28:00

citykunan发表于2005-1-10 13:10:00static/image/common/back.gifDWF Composer我知道,可是老板只要在cad中加密和解密。我试想把老板做在批注放在一个图层上,随后lock,就能改了。但是别人可以unlock。lisp能不能让某个图层不可...

获取可以指望autodesk增加Layer的Unlock的功能,使其可以设定密码....<br>
目前行不通的情况下还是另想他途为好<br>

alin 发表于 2005-1-13 13:55:00

Reactor or CADLock

citykunan 发表于 2005-1-13 14:05:00

反应器怎么用啊,能不能给个思路。谢谢。

alin 发表于 2005-1-13 14:27:00

<A href="http://www.cadvault.com/forums/archive/index.php/t-9994.html" target="_blank" >http://www.cadvault.com/forums/archive/index.php/t-9994.html</A>

citykunan 发表于 2005-1-13 16:09:00

多谢alin版主,我想改一下程序想把他变成永久性反应器(vlr-pers),可是,每次重新打开图纸后,先要加载lock2,lock3字函数才能实现反应器。有没有办法实现关闭和打开后,不加载程序同时也不能解锁图层呢。谢谢。


(defun LockL (strLayer /)<BR>       (setq strLayer (getstring "\nEnter Layername to lock down: "))<BR>       (lockl strLayer)<BR>)<BR>(defun lockl (strLayer / colLayers lstObjects objLayer strLayer)<BR>       (if (tblsearch "layer" strLayer)<BR>                       (progn<BR>                                       (setq colLayers       (vla-get-layers<BR>                       (vla-get-activedocument<BR>                                       (vlax-get-acad-object)<BR>                       )<BR>                                                               )<BR>                               objLayer               (vla-item colLayers strLayer)<BR>                               lstObjects (list objLayer)<BR>                                       )<BR>                                       (if (not rxnLockLayer)<BR>        ;(setq rxnLockLayer               (vlr-object-reactor<BR>        ;                                               lstObjects<BR>        ;                                               "Locked Layer"<BR>        ;                                               '((:vlr-Modified . LockL2))<BR>        ;                               )<BR>                                                                               (setq rxnLockLayer       (vlr-pers (vlr-object-reactor<BR>                                                       lstObjects<BR>                                                       "Locked Layer"<BR>                                                       '((:vlr-Modified . lockl2))<BR>       <BR>                                       ) <BR>                                                                                                                                                                                                       )                                               <BR>                                       rxnComEndLL       (vlr-pers (vlr-editor-reactor<BR>                                                       nil<BR>                                                       '((:vlr-commandended . LockL3))<BR>                                       ) <BR>                                                                                                                                                                                                       )<BR>        )<BR>        (vlr-owner-add rxnLockLayer objLayer)<BR>                                       )<BR>                       )<BR>       )<BR>        )<BR>(defun LockL2 (objOwner objReactor lstEntity)<BR>       (if DEBUG<BR>                       (print "LockL2")<BR>       )<BR>       (if (not blnRerunLL)<BR>                       (setq lstChangedLayer<BR>                       (cons objOwner<BR>               lstChangedLayer<BR>                       )<BR>                       )<BR>       )<BR>)<BR>(defun LockL3 (CALL CALLBACK)<BR>       (if DEBUG<BR>                       (print "LockL3")<BR>       )<BR>       (if lstChangedLayer<BR>                       (progn<BR>                                       (setq blnReRunLL T)<BR>                                       (foreach objLayer        lstChangedLayer<BR>        (vla-put-lock objLayer :vlax-true)


                                       )<BR>                                       (setq blnReRunLL                               nil<BR>                               lstChangedLayer nil<BR>                                       )<BR>                       )<BR>       )<BR>)

fango 发表于 2005-1-13 19:18:00

DWF Composer 应该可以满足要求,但是国内找不到,该软件的应用的也少啊,谁有?能共享吗?

Ea 发表于 2005-1-14 06:38:00

<FONT face=宋体 size=1>(vl-load-com)<BR>(setvar "cmdecho" 0)<BR>(if (and (&gt;= (atof (getvar "acadver")) 15.)<BR>(vlax-ldata-list "Ea_locked")<BR>(ssget "x" '((1 . "DWG Is Locked!")))<BR>                       ) ;_ 结束and<BR>       (progn<BR>                       (princ "\n图形加载中, 请稍候.......")<BR>                       (setq thisdocument<BR>               (vlax-get-property (vlax-get-acad-object) 'activedocument)<BR>                       ) ;_ 结束setq<BR>                               (defun e:DelALL ()<BR>                                       (vlax-map-collection<BR>(vla-get-layers<BR>       thisdocument<BR>) ;_ 结束vla-get-layers<BR>'(lambda (x) (vla-put-lock x :vlax-false))<BR>                                       ) ;_ 结束vlax-map-collection<BR>                                       (vlax-map-collection<BR>(vlax-get-property<BR>       thisdocument<BR>       'modelspace<BR>) ;_ 结束vlax-get-property<BR>'(lambda (x)<BR>               (vla-delete x)<BR>) ;_ 结束lambda<BR>                                       ) ;_ 结束vlax-map-collection<BR>                                       (vla-purgeall thisdocument) ;_ 结束vla-purgeall<BR>                       ) ;end defun<BR>                       ;;editor 反应器回调函数,执行删除实体<BR>                       (defun DelAllObject (var1 var2)<BR>                                       (e:delall)<BR>                                       (vla-eval (vlax-get-acad-object)<BR>(strcat<BR>       "MsgBox \"★ 版       权       所       有 ★\""<BR>       ", "<BR>       "vbExclamation+vbSystemModal"<BR>       ", "<BR>       "\"作者: Eachy\""<BR>)<BR>                                       )<BR>                                       (princ)<BR>                       ) ;_ 结束defun<BR>                       ;;main<BR>                       (vl-cmdf ".undo" "a" "off")<BR>                       (vl-cmdf ".undo" "c" "N")<BR>                       (mapcar '(lambda (x) (vl-cmdf ".undefine" x))<BR>                       '("U" "Wblock" "Qsave" "save" "NEW")<BR>                       ) ;_ 结束mapcar<BR>                       ;;清理环境<BR>                       (if (and (= (getvar "sdi") 0)<BR>                               (&gt; (vla-get-count<BR>       (vlax-get-property (vlax-get-acad-object) 'documents)<BR>)<BR>1<BR>                               )<BR>)<BR>                                       (progn<BR>(vlax-for item (vlax-get-property<BR>(vlax-get-acad-object)<BR>'documents<BR>                                               )<BR>       (if (/= (vla-get-name item) (getvar "dwgname"))<BR>                       (vla-close item :vlax-true (vla-get-name item))<BR>       )<BR>)<BR>(vla-eval (vlax-get-acad-object)<BR>       (strcat<BR>                       "MsgBox \"★ 版       权       所       有 ★\""<BR>                       ", "<BR>                       "vbExclamation+vbSystemModal"<BR>                       ", "<BR>                       "\"作者: Eachy\""<BR>               )<BR>)<BR>                                       )<BR>                       )<BR>                       (vlax-map-collection<BR>                                       (vla-get-layers thisdocument)<BR>                                       '(lambda (x) (vla-put-lock x :vlax-false))<BR>                       )<BR>                       ;;删除标记<BR>                       (vl-cmdf ".erase" (ssget "x" '((1 . "DWG Is Locked!"))) "")<BR>                       ;;准备还原<BR>                       (setq count (sslength (ssget "x"))<BR>       l count<BR>       an 0.<BR>                       ) ;_ 结束setq                       <BR>                       (while (&gt; count 0)<BR>                                       (grtext -2<BR>                                       (strcat "已完成 "<BR>                                       (rtos (/ (* 100.0 (- l count)) l)<BR>                       2<BR>                       0<BR>                                       )<BR>                                       "%...."<BR>                                       )<BR>                                       )<BR>                                       (setq<BR>obj (vla-item (vlax-get-property<BR>thisdocument<BR>'modelspace<BR>                                       ) ;_ 结束vlax-get-property<BR>                                       (setq count (1- count))<BR>                       ) ;_ 结束vla-item<BR>                                       ) ;_ 结束setq<BR>                                       (vla-move obj<BR>(vlax-3d-point '(0. 0. 0.))<BR>(vlax-3d-point<BR>       (polar '(0. 0. 0.)<BR>(setq an (+ an (/ pi 80)))<BR>(- (- (* (float count) (float count))<BR>                                               (* (1- (float count)) 2)<BR>                       ) ;_ 结束-<BR>) ;_ 结束-<BR>       ) ;_ 结束polar<BR>) ;_ 结束vlax-3d-point<BR>                                       ) ;end vla-move<BR>                                       (vla-put-visible obj :vlax-true)<BR>                       ) ;end while<BR>                       (vla-zoomextents (vla-get-application (vlax-get-acad-object)))<BR>                       (setq count nil<BR>       an nil<BR>       l nil<BR>       obj nil<BR>                       )<BR>                       ;;还原结束清理变量<BR>                       ;;锁定全部图层<BR>                       (vlax-map-collection<BR>                                       (vla-get-layers thisdocument)<BR>                                       '(lambda (x) (vla-put-lock x :vlax-true))<BR>                       ) ;_ 结束vlax-map-collection<BR>                       ;;反应器部分<BR>                       ;;文档反应器,禁止新建,测试中可能不稳定<BR>                       (if (not myDocReactor)<BR>                                       (setq myDocReactor<BR>                               (vlr-docmanager-reactor<BR>                                               nil<BR>                                               '((:vlr-documentcreated . sDelAllObject))<BR>                               ) ;_ 结束vlr-docmanager-reactor<BR>                                       ) ;_ 结束setq<BR>                       ) ;_ 结束vlr-docmanager-reactor<BR>                       ;;文档反应器回调,删除加密图形中的实体<BR>                       (defun sDelAllObject (var1 var2)<BR>                                       ;;解锁图层<BR>                                       (vlax-map-collection<BR>(vla-get-layers<BR>       thisdocument<BR>) ;_ 结束vla-get-layers<BR>'(lambda (x) (vla-put-lock x :vlax-false))<BR>                                       ) ;_ 结束vlax-map-collection<BR>                                       (vlax-map-collection<BR>(vlax-get-property<BR>       thisdocument<BR>       'modelspace<BR>) ;_ 结束vlax-get-property<BR>'(lambda (x)<BR>               (vla-delete x)<BR>) ;_ 结束lambda<BR>                                       ) ;_ 结束vlax-map-collection<BR>                                       (vla-purgeall thisdocument)<BR>                       ) ;_ 结束defun<BR>                       ;;禁止 Wblock 方法<BR>                       (vlr-wblock-reactor<BR>                                       nil<BR>                                       '((:VLR-wblockNotice . DelAllObject))<BR>                       ) ;_ 结束vlr-wblock-reactor<BR>                       ;;数据库反应器,禁止新加及修改,包括 VBA 方法<BR>                       (vlr-acdb-reactor<BR>                                       "Ea-acdb-reactor"<BR>                                       '((:vlr-objectModified . SaveChangedLyr) ;修改<BR>(:vlr-objectAppended . SaveChangedLyr) ;添加<BR>                                               )<BR>                       ) ;_ 结束vlr-acdb-reactor<BR>                       ;;禁止 ARX 深度克隆<BR>                       (vlr-deepclone-reactor<BR>                                       nil<BR>                                       '((:vlr-begindeepclone . DelAllObject))<BR>                       ) ;_ 结束vlr-deepclone-reactor<BR>                       ;;编辑器反应器<BR>                       (vlr-editor-reactor<BR>                                       nil<BR>                                       '((:vlr-beginDxfOut . DelAllObject) ;禁止dxfout<BR>(:vlr-beginSave . DelAllObject) ;禁止保存<BR>(:vlr-lispWillStart . DelAllObject) ;防止Lisp输出<BR>(:vlr-commandwillstart . ESCcommand)<BR>(:vlr-commandended . DelAllNew) ;禁止在图形内绘制<BR>(:vlr-commandcancelled . DelAllNew)<BR>;命令中断时检查是否有新实体<BR>(:vlr-lispEnded . DelAllNew) ;检查Lisp生成的新实体<BR>(:vlr-lispCancelled . DelAllNew) ;中断后是否有新实体<BR>(:vlr-sysvarchanged . myResetSysvar) ;防止修改 savetime<BR>                                               )<BR>                       ) ;_ 结束vlr-editor-reactor<BR>                       ;;Command 开始时执行 ESC,经测试不能屏蔽 VBAIDE Vlide Ctrl+P<BR>                       (defun ESCCommand (var1 var2 /)<BR>                                       (if<BR>(or (not (wcmatch (strcase (vl-princ-to-string (car var2)))<BR>       "*ZOOM,*PAN,*QUIT,*EXIT,*CLOSE"<BR>) ;_ 结束wcmatch<BR>                       ) ;_ 结束not<BR>                       (wcmatch (strcase (vl-princ-to-string (car var2))) "*PLOT")<BR>) ;_ 结束or<BR>(progn<BR>               (vla-eval (vlax-get-acad-object)<BR>                               (strcat "Sendkeys \"{ESC}\"")<BR>               ) ;发送 中断命令<BR>               (vla-eval (vlax-get-acad-object)<BR>                               (strcat "Sendkeys \"{ESC}\"")<BR>               )<BR>) ;_ 结束if<BR>(princ)<BR>                                       ) ;_ 结束if<BR>                       ) ;_ 结束defun<BR>                       ;;设置自动保存时间<BR>                       (defun myResetSysvar (var1 var2)<BR>                                       (if (/= (vlax-variant-value<BR>(vla-GetVariable<BR>       thisdocument<BR>       "savetime"<BR>) ;_ 结束vla-GetVariable<BR>                                       ) ;_ 结束vlax-variant-value<BR>                                       600<BR>       ) ;_ 结束/=<BR>(vla-setvariable<BR>       thisdocument<BR>       "savetime"<BR>       600<BR>) ;_ 结束vla-setvariable<BR>                                       ) ;_ 结束if<BR>                       ) ;_ 结束defun<BR>                       ;;删除所有新生成的 Mspace 空间实体<BR>                       (defun DelAllNew (var1 var2 / lyrs lyrlst item)<BR>                                       (setq lyrs (vla-get-layers<BR>               thisdocument<BR>) ;_ 结束vla-get-layers<BR>                                       ) ;_ 结束setq<BR>                                       (if HasChangedObject<BR>(progn<BR>       (mapcar<BR>                       '(lambda (item / name lyr lyrobj)<BR>                                               (IF (not (vlax-erased-p item))<BR>(progn<BR>               (setq<BR>                               name (strcase (vla-get-objectname item))<BR>               ) ;_ 结束setq<BR>               (if (vl-position<BR>name<BR>'("ACDB3DFACE" "ACDB3DPOLYLINE"<BR>               "ACDB3DSOLID" "ACDBARC"<BR>               "ACDBATTRIBUTE"<BR>               "ACDBATTRIBUTEDEFINITION"<BR>               "ACDBBLOCKREFERENCE" "ACDBCIRCLE"<BR>               "ACDB3POINTANGULAR" "ACDBALIGNED"<BR>               "ACDBANGULAR" "ACDBROTATED"<BR>               "ACDBELLIPSE" "ACDBERNALREFERENCE"<BR>               "ACDBHATCH" "ACDBLEADER"<BR>               "ACDBPOLYLINE" "ACDBLINE"<BR>               "ACDBMINSERTBLOCK" "ACDBMLINE"<BR>               "ACDBMTEXT" "ACDBPOINT"<BR>               "ACDBPOLYFACEMESH" "ACDBPOLYGONMESH"<BR>               "ACDBPVIEWPORT" "ACDBRASTER"<BR>               "ACDBREGION" "ACDBSHAPE"<BR>               "ACDBSOLID" "ACDBSPINE"<BR>               "ACDBTABLE" "ACDBTEXT"<BR>               "ACDB2DPOLYLINE" "ACDBTOLERANCE"<BR>       )<BR>                                               ) ;_ 结束vl-position<BR>                               (progn<BR>                                               (setq lyr (vla-get-layer item))<BR>                                               (if<BR>(= (vla-get-lock<BR>                                       (setq lyrobj (vla-item lyrs lyr))<BR>                       ) ;_ 结束vla-get-lock<BR>                       :vlax-true<BR>) ;_ 结束=<BR>       (vla-put-lock lyrobj :vlax-false)<BR>                                               ) ;_ 结束if<BR>                                               (vla-delete item)<BR>                               ) ;_ 结束progn<BR>               ) ;_ 结束if<BR>) ;_ 结束progn<BR>                                               ) ;_ 结束IF<BR>                               ) ;_ 结束lambda<BR>                       (vl-remove nil<BR>                                               (mapcar 'vlax-ename-&gt;vla-object<BR>                                               HasChangedObject<BR>                                               ) ;_ 结束mapcar<BR>                       ) ;_ 结束vl-remove<BR>       ) ;_ 结束mapcar<BR>       (setq HasChangedObject nil)<BR>) ;_ 结束progn<BR>                                       ) ;_ 结束if<BR>                                       (vlax-map-collection<BR>(vla-get-layers thisdocument) ;_ 结束vla-get-layers<BR>'(lambda (x) (vla-put-lock x :vlax-true))<BR>                                       ) ;_ 结束vlax-map-collection<BR>                       ) ;_ 结束defun<BR>                       ;;acdb 回调函数, 保存修改或者新加的实体<BR>                       (defun SaveChangedlyr (var1 var2 /)<BR>                                       (if (not HasChangedObject)<BR>(setq HasChangedObject (list (cadr var2)))<BR>(setq HasChangedObject<BR>                                               (append (list (cadr var2)) HasChangedObject)<BR>) ;_ 结束setq<BR>                                       ) ;_ 结束if<BR>                       ) ;end defun<BR>       ) ;end progn<BR>       (progn<BR>                       (vlr-remove-all)<BR>                       (setq myEditorReactor<BR>               nil<BR>       myEditwblockreactor<BR>               nil<BR>       myAcdbReactor<BR>               nil<BR>       thisdocument<BR>               nil<BR>       myDeepclonereactor<BR>               nil<BR>       HasChangedObject<BR>               NIL<BR>                       ) ;end setq<BR>       ) ;end progn<BR>) ;_ 结束if<BR>(princ)<BR></FONT>



citykunan 发表于 2005-1-14 09:02:00

真是太感谢EA贵宾了,也谢谢龙版主和ALIN版主,我一定努力学习。德国老板很烦的,要求很多,我个人能力又有限,多亏有明经这么好的论坛能让我向诸位学习。我在这里学到了很多,我也会尽我的努力为明经多做贡献。


还想问一下16楼的程序,能改成永久反应器吗?再次感谢各位人心人。

citykunan 发表于 2005-1-14 14:57:00

我研究了一下EA的程序,我有一点不是很明白<FONT size=2>(ssget "x" '((1 . "DWG Is Locked!")))这一句是怎么做到的?不知程序如何运行。TAHNKS</FONT>
页: 1 [2] 3
查看完整版本: 关于批注的问题