明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: citykunan

关于批注的问题

  [复制链接]
 楼主| 发表于 2005-1-13 09:51:00 | 显示全部楼层
是啊,我通常只上明经,也只有明经的积分,龙版主能不能帮我粘过来,或者发一个到我的信箱。谢谢。
发表于 2005-1-13 13:28:00 | 显示全部楼层
citykunan发表于2005-1-10 13:10:00DWF Composer我知道,可是老板只要在cad中加密和解密。我试想把老板做在批注放在一个图层上,随后lock,就能改了。但是别人可以unlock。lisp能不能让某个图层不可...
获取可以指望autodesk增加Layer的Unlock的功能,使其可以设定密码....
目前行不通的情况下还是另想他途为好
发表于 2005-1-13 13:55:00 | 显示全部楼层
Reactor or CADLock
 楼主| 发表于 2005-1-13 14:05:00 | 显示全部楼层
反应器怎么用啊,能不能给个思路。谢谢。
发表于 2005-1-13 14:27:00 | 显示全部楼层
 楼主| 发表于 2005-1-13 16:09:00 | 显示全部楼层
多谢alin版主,我想改一下程序想把他变成永久性反应器(vlr-pers),可是,每次重新打开图纸后,先要加载lock2,lock3字函数才能实现反应器。有没有办法实现关闭和打开后,不加载程序同时也不能解锁图层呢。谢谢。 (defun LockL (strLayer /)
(setq strLayer (getstring "\nEnter Layername to lock down: "))
(lockl strLayer)
)
(defun lockl (strLayer / colLayers lstObjects objLayer strLayer)
(if (tblsearch "layer" strLayer)
(progn
(setq colLayers (vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
objLayer (vla-item colLayers strLayer)
lstObjects (list objLayer)
)
(if (not rxnLockLayer)
;(setq rxnLockLayer (vlr-object-reactor
; lstObjects
; "Locked Layer"
; '((:vlr-Modified . LockL2))
; )
(setq rxnLockLayer (vlr-pers (vlr-object-reactor
lstObjects
"Locked Layer"
'((:vlr-Modified . lockl2))

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

评分

参与人数 1威望 +1 金钱 +4 贡献 +4 激情 +4 收起 理由
龙龙仔 + 1 + 4 + 4 + 4 【好评】好程序

查看全部评分

 楼主| 发表于 2005-1-14 09:02:00 | 显示全部楼层
真是太感谢EA贵宾了,也谢谢龙版主和ALIN版主,我一定努力学习。德国老板很烦的,要求很多,我个人能力又有限,多亏有明经这么好的论坛能让我向诸位学习。我在这里学到了很多,我也会尽我的努力为明经多做贡献。


还想问一下16楼的程序,能改成永久反应器吗?再次感谢各位人心人。
 楼主| 发表于 2005-1-14 14:57:00 | 显示全部楼层
我研究了一下EA的程序,我有一点不是很明白(ssget "x" '((1 . "DWG Is Locked!")))这一句是怎么做到的?不知程序如何运行。TAHNKS
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-9-29 20:24 , Processed in 0.179679 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表