永久物件反應器例子
;|Adds a persistant reactor to a pline object that
updates a selected text object to the plines area
in square feet.You will have to have the subs loaded
in everydrawing for it to work, so that it know what
to do with the reactor, because it is saved with the
drawing. If the text object is deleted, then the
program will remove the reactor related to the pline.
v1.0 4/2006LUCAS(龙龙仔)
|;
(vl-load-com)
(if (and (not ALL_LIST_LAI)
(setq LST (cdar (vlr-reactors :vlr-object-reactor)))
)
(mapcar '(lambda (X)
(if (= (vlr-data X) "Area_Reactor")
(setq ALL_LIST_LAI (cons X ALL_LIST_LAI))
)
)
LST
)
)
(if (not ENDOUT)
(setq ENDOUT
(vlr-dwg-reactor
NIL
'((:vlr-beginsave . ENDBEGIN) (:vlr-savecomplete . ENDSAVE))
)
)
)
(defun ENDBEGIN (OBJ REACT)
(foreach I ALL_LIST_LAI
(if (or (vlax-erased-p (car (vlr-owners I)))
(vlax-erased-p (cadr (vlr-owners I)))
)
(progn
(vlr-pers-release I)
(vlr-remove I)
)
)
)
)
(defun ENDSAVE (OBJ REACT)
(foreach I ALL_LIST_LAI (vlr-add I) (vlr-pers I))
(princ)
)
(defun C:AREA_REACTOR (/ ENT POLYOBJ TEXTOBJ)
(if
(and
(setq ENT (entsel "\n Select Pline to get area of: "))
(setq POLYOBJ (vlax-ename->vla-object (car ENT)))
(wcmatch (vla-get-objectname POLYOBJ)
"AcDb2dPolyline,AcDbPolyline"
)
(setq ENT (entsel "\n Select Text of hold area value: "))
(setq TEXTOBJ (vlax-ename->vla-object (car ENT)))
(wcmatch (vla-get-objectname TEXTOBJ) "AcDbText,AcDbMText")
)
(progn
(vla-put-textstring
TEXTOBJ
(strcat (rtos (/ (vla-get-area POLYOBJ) 1000000.0) 2 4)
"㎡"
)
)
(setq ALL_LIST_LAI
(cons (vlr-pers
(vlr-object-reactor
(list POLYOBJ TEXTOBJ)
"Area_Reactor"
'((:vlr-modified . MODREACTOR))
)
)
ALL_LIST_LAI
)
)
)
)
(princ)
)
(defun MODREACTOR (OBJ REACT NOTSURE)
(if (and (wcmatch (getvar "cmdnames") "SCALE,STRETCH,GRIP_STRETCH")
(vlax-property-available-p OBJ 'AREA)
)
(setq MODIFY_OBJ (cons (cons OBJ REACT) MODIFY_OBJ))
)
(princ)
)
(if (not ADTEXTCOMEND)
(setq ADTEXTCOMEND
(vlr-command-reactor
NIL
'((:vlr-commandended . ADTEXTOBJ))
)
)
)
(defun ADTEXTOBJ (OBJ REACT)
(if MODIFY_OBJ
(progn
(foreach OBJ MODIFY_OBJ
(if (and (not (vlax-erased-p (car OBJ)))
(not (vlax-erased-p (car (vlr-owners (cdr OBJ))))
)
)
(vla-put-textstring
(car (vlr-owners (cdr OBJ)))
(strcat (rtos (/ (vla-get-area (car OBJ)) 1000000.0) 2 4)
"㎡"
)
)
)
)
(setq MODIFY_OBJ NIL)
)
)
)
(princ "\nType Area_Reactor,By Lucas")
(princ)
<P>沙发。</P>
<P>谢谢楼主。收了。</P> <P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan">注意:程序不能编译为独立变量空间程序!为甚么不行?<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p></P>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan">主要是独立变量空间中只能存放一个永久反应器物件,当程序產生多於一个永久反应器物件,程序并不能取得其他的永久反应器物件!!</P>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan">即(vlr-reactors :vlr-object-reactor)没法取得其他的永久反应器物件!!</P> <P>版 主能不能解释一下独立空间的特点，</P>
<P>(acad_colordlg)函数在独立空间下竟然是未知命令。我昏。</P> <P>独立空间----编译时加在程序最前面</P>
<P>(if (findfile "acapp.arx")<BR> (progn<BR> (arxload "acapp.arx" NIL)<BR> (vl-arx-import "acapp.arx")<BR> )<BR>)</P> <p>程序很精彩。。我更想知道"㎡"里面的平方米是怎么一次就可以打得出来啊！</p><p>我只能打出"m2"</p> 从Word或Excel里复制㎡ hhc发表于2007-6-12 7:28:00static/image/common/back.gif从Word或Excel里复制㎡
<p></p><p>这个方法我试过了。先在word里面写入"m2",然后让"2"成为上标，是这样子吧？</p><p>复制到VLISP编辑器里面的话，自动变回成"m2"....</p> 本帖最后由 作者 于 2007-7-24 7:20:33 编辑 <br /><br /> <p>请问版主</p><p>假如说是选取 "PLINE" 自动产生 "TEXT" 物件并带有面积数值,<br/>且当进行 "PLINE" 物件 "复制" ,可自动关联产生 "TEXT" 物件,<br/>并内容是其面积值,该怎样做到复制的反应动作呢?</p><p>是要使用 vlr-object-reactor 的 vlr-copied ,<br/>还是 vlr-editor-reactor 或是其他 ?<br/>因为资料有现,不知道哪里还有其他的介绍 ?<br/>希望版主或是其他高手可以解答一下.<br/>谢谢!<br/></p> <p>1.选取 "PLINE" 自动产生 "TEXT" 物件并带有面积数值</p><p>=>你應可自已解決 8-)</p><p>2.且当进行 "PLINE" 物件 "复制" ,可自动关联产生 "TEXT" 物件</p><p>=>使用vlr-copied <br/></p><p></p>