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