永久物件反應器例子

龙龙仔 · 发表于 2006-11-16 10:05:00

;| 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/2006 LUCAS(龙龙仔)
|;
(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)

;|  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/2006  LUCAS(龙龙仔)
|;
(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)

oyxx1023 · 发表于 2006-11-16 10:12:00

沙发。

谢谢楼主。收了。

龙龙仔 · 发表于 2006-11-16 15:57:00

注意:程序不能编译为独立变量空间程序!为甚么不行?

主要是独立变量空间中只能存放一个永久反应器物件,当程序產生多於一个永久反应器物件,程序并不能取得其他的永久反应器物件!!

即(vlr-reactors :vlr-object-reactor)没法取得其他的永久反应器物件!!

oyxx1023 · 发表于 2006-11-16 16:09:00

版　主能不能解释一下独立空间的特点，

(acad_colordlg)函数在独立空间下竟然是未知命令。我昏。

龙龙仔 · 发表于 2006-11-16 17:13:00

独立空间----编译时加在程序最前面

(if (findfile "acapp.arx")
(progn
(arxload "acapp.arx" NIL)
(vl-arx-import "acapp.arx")
)
)

carrot1983 · 发表于 2007-6-11 14:55:00

程序很精彩。。我更想知道"㎡"里面的平方米是怎么一次就可以打得出来啊！

我只能打出"m2"

hhc · 发表于 2007-6-12 07:28:00

从Word或Excel里复制㎡

carrot1983 · 发表于 2007-6-12 08:35:00

hhc发表于2007-6-12 7:28:00从Word或Excel里复制㎡

这个方法我试过了。先在word里面写入"m2",然后让"2"成为上标，是这样子吧？

复制到VLISP编辑器里面的话，自动变回成"m2"....

vken7az2p · 发表于 2007-7-24 07:13:00

本帖最后由作者于 2007-7-24 7:20:33 编辑

请问版主

假如说是选取 "PLINE" 自动产生 "TEXT" 物件并带有面积数值,
且当进行 "PLINE" 物件 "复制" ,可自动关联产生 "TEXT" 物件,
并内容是其面积值,该怎样做到复制的反应动作呢?

是要使用 vlr-object-reactor 的 vlr-copied ,
还是 vlr-editor-reactor 或是其他 ?
因为资料有现,不知道哪里还有其他的介绍 ?
希望版主或是其他高手可以解答一下.
谢谢!

龙龙仔 · 发表于 2007-7-24 12:36:00

1.选取 "PLINE" 自动产生 "TEXT" 物件并带有面积数值

=>你應可自已解決 8-)

2.且当进行 "PLINE" 物件 "复制" ,可自动关联产生 "TEXT" 物件

=>使用vlr-copied

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

永久物件反應器例子

评分