[讨论]：正在学习反应器，请赐教

eachy · 发表于 2004-3-4 21:36:51

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

贴几个搜来的帖子
http://cadence.advanstar.com/1999/0999/toolbox0999.html

;;Listing 1. Set Up Counter Reactors
;;
(defun C:COUNTER ()
;;
(vl-load-com)
;;load reactor handling system
;;
;; Clear any current command reactors
(Reactor_Remove "CntCommands")
;;
;; Define reactor link to AutoCAD
(setq CommReact (vlr-command-reactor
"CntCommands"
'((:vlr-CommandWillStart . CountCommands))
)
AcDbReact (vlr-AcDb-Reactor
"CntCommands"
'((:vlr-ObjectAppended . CountAdd)
(:vlr-ObjectErased . CountDel)
)
)
)
;;
;; Initialize variables
(setq MyCounter nil
AddCounter
0
DelCounter 0
)
;;
;; Define as persistant - will remain
;; with drawing and require reloading
;; of modules when drawing reloaded.
;;(vlr-pers CommReact)
;;
(prompt "\nCOUNTER reactor is now ready.")
(princ)
)
;Listing 2. Remove Reactors by Name
;;
(defun Reactor_Remove (Nam / ReactorsInDwg ReactorGroup ReactorObject)
(setq ReactorsInDwg (VLR-Reactors))
(foreach ReactorGroup ReactorsInDwg
(foreach ReactorObject (cdr ReactorGroup)
(if (= (VLR-Data ReactorObject) Nam)
(VLR-Remove ReactorObject)
)
)
)
)
; Listing 3. Command Reactor Callback Function
;;
(defun CountCommands (Reactor-name Nam / TMP1 TMP2)
(setq Nam (car Nam)
;;we only want the command
TMP1 (assoc Nam MyCounter)
)
(if TMP1
;;found in list already?
(setq TMP2 (list Nam (1+ (cadr TMP1)))
MyCounter (subst TMP2 TMP1 MyCounter)
)
(setq TMP1 (list Nam 1)
MyCounter (cons TMP1 MyCounter)
)
)
)
; Listing 4. Database Callback Functions
;;
(defun CountAdd (Reactor-Name Data)
(setq AddCounter (1+ AddCounter))
)
;;
(defun CountDel (Reactor-Name Data)
(setq DelCounter (1+ DelCounter))
)
;Listing 5. Reporting Function to List Contents of MYCOUNTER
;;
(defun C:COUNTS (/ TMP)
(prompt "\nCommands counted.")
(foreach TMP MyCounter
(prompt (strcat "\n" (car TMP) "\t" (itoa (cadr TMP))))
)
(prompt (strcat "\n"
(itoa AddCounter)
" objects added and "
(itoa DelCounter)
" objects removed."
)
)
(princ)
)
; Listing 6. Connect Circles with a Line
; Listing 7. Drawing a Line Between Circles
;;
(defun C:CONNECT ()
(setq EN1 (car (entsel "\nPick a circle: "))
EN2 (car (entsel " and another: "))
RCnt (if RCnt
(1+ RCnt)
1
)
Connect_Flag 'T
)
(if (and EN1 EN2)
(progn
(vl-load-com)
(setq EN3 (Connection EN1 EN2)
EN3 (vlax-ename->vla-object EN3)
EN1 (vlax-ename->vla-object EN1)
EN2 (vlax-ename->vla-object EN2)
)
(vlr-object-reactor
(list EN1 EN2 EN3)
(strcat "Connect Circles " (itoa RCnt))
'((:vlr-modified . ConnectFix)
;(:vlr-erased . ConnectKill)
)
)
)
)
)
;;
(defun Connection (EN1 EN2 / EL1 EL2)
(setq EN1 (if (= (type EN1) 'EName)
EN1
(vlax-vla-object->ename EN1)
)
EN2 (if (= (type EN2) 'Ename)
EN2
(vlax-vla-object->ename EN2)
)
EL1 (entget EN1)
EL2 (entget EN2)
R1 (cdr (assoc 40 EL1))
R2 (cdr (assoc 40 EL2))
P1 (cdr (assoc 10 EL1))
P2 (cdr (assoc 10 EL2))
A1 (angle P1 P2)
P1 (polar P1 A1 R1)
P2 (polar P2 (+ A1 PI) R2)
)
(entmake (list
'(0 . "LINE")
(assoc 8 EL1)
(cons 10 P1)
(cons 11 P2)
)
)
(entlast)
)
;Listing 8. Entity Object Callback Function
;;
(defun ConnectFix (Not_Obj
;;caused notification
Re_Obj
;;reactor object
PList
;;parameters list
/ ObjList
;;objects in reactor set
VObj
;;VLA object
EN
;;Entity name
EL
;;Entity list
ENL
;;Entity list for line
P1
;;Center/end point 1
P2
;;Center/end point 2
R1
;;Radius 1
R2
;;Radius 2
SkipIt
;;Process change flag
)
;;
(if Connect_Flag
(progn
(setq Connect_Flag nil)
;;
;;Get list of objects associated with the
;;reactor that caused the call back.
;;
(setq ObjList (vlr-owners Re_Obj))
;;
;;Loop through each object in list
(foreach VObj ObjList
;;
;;Convert object reference to AutoLISP style
(setq EN (vlax-vla-object->ename VObj)
EL (entget EN)
)
(cond ;;what type of entity is it?
((= (cdr (assoc 0 EL)) "LINE")
;;Did the line object cause the callback?
(if (eq Not_Obj VObj)
;;if so, skip it.
(setq SkipIt 'T)
)
(setq ENL EL)
;;save entity list of line
)
('T
;;Otherwise it is one of the circles.
;;get the center point and radius
(set (if (boundp 'P1)
'P2
'P1
)
(cdr (assoc 10 EL))
)
(set (if (boundp 'R1)
'R2
'R1
)
(cdr (assoc 40 EL))
)
)
)
)
(setq AA (angle P1 P2)
;;angle between circles
;;adjust points P1 and P2
P1 (polar P1 AA R1)
P2 (polar P2 (+ AA PI) R2)
;;replace values in entity list
ENL (subst (cons 10 P1)
(assoc 10 ENL)
ENL
)
ENL (subst (cons 11 P2)
(assoc 11 ENL)
ENL
)
)
(if (null SkipIt)
(progn
(entmod ENL)
;;update the line
)
(prompt "\nConnection broken.")
)
(setq Connect_Flag 'T)
)
;;end PROGN
)
;;end IF
)

;;Listing 1. Set Up Counter Reactors 
 
;; 
(defun C:COUNTER () 
  ;; 
  (vl-load-com) 
  ;;load reactor handling system 
  ;; 
  ;; Clear any current command reactors 
  (Reactor_Remove "CntCommands") 
  ;; 
  ;; Define reactor link to AutoCAD 
  (setq        CommReact (vlr-command-reactor 
                    "CntCommands" 
                    '((:vlr-CommandWillStart . CountCommands)) 
                  ) 
        AcDbReact (vlr-AcDb-Reactor 
                    "CntCommands" 
                    '((:vlr-ObjectAppended . CountAdd) 
                      (:vlr-ObjectErased . CountDel) 
                     ) 
                  ) 
  ) 
  ;; 
  ;; Initialize variables 
  (setq        MyCounter nil 
        AddCounter 
         0 
        DelCounter 0 
  ) 
  ;; 
  ;; Define as persistant - will remain 
  ;; with drawing and require reloading 
  ;; of modules when drawing reloaded. 
  ;;(vlr-pers CommReact) 
  ;; 
  (prompt "\nCOUNTER reactor is now ready.") 
  (princ) 
) 
 
;Listing 2. Remove Reactors by Name 
 
;; 
(defun Reactor_Remove (Nam / ReactorsInDwg ReactorGroup        ReactorObject) 
  (setq ReactorsInDwg (VLR-Reactors)) 
  (foreach ReactorGroup        ReactorsInDwg 
    (foreach ReactorObject (cdr ReactorGroup) 
      (if (= (VLR-Data ReactorObject) Nam) 
        (VLR-Remove ReactorObject) 
      ) 
    ) 
  ) 
) 
; Listing 3. Command Reactor Callback Function 
 
;; 
(defun CountCommands (Reactor-name Nam / TMP1 TMP2) 
  (setq        Nam  (car Nam) 
        ;;we only want the command 
        TMP1 (assoc Nam MyCounter) 
  ) 
  (if TMP1 
    ;;found in list already? 
    (setq TMP2            (list Nam (1+ (cadr TMP1))) 
          MyCounter (subst TMP2 TMP1 MyCounter) 
    ) 
    (setq TMP1            (list Nam 1) 
          MyCounter (cons TMP1 MyCounter) 
    ) 
  ) 
) 
; Listing 4. Database Callback  Functions 
 
;; 
(defun CountAdd        (Reactor-Name Data) 
  (setq AddCounter (1+ AddCounter)) 
) 
;; 
(defun CountDel        (Reactor-Name Data) 
  (setq DelCounter (1+ DelCounter)) 
) 
 
;Listing 5. Reporting Function to List Contents of MYCOUNTER 
 
;; 
(defun C:COUNTS        (/ TMP) 
  (prompt "\nCommands counted.") 
  (foreach TMP MyCounter 
    (prompt (strcat "\n" (car TMP) "\t" (itoa (cadr TMP)))) 
  ) 
  (prompt (strcat "\n" 
                  (itoa AddCounter) 
                  " objects added and " 
                  (itoa DelCounter) 
                  " objects removed." 
          ) 
  ) 
  (princ) 
) 
 
; Listing 6. Connect Circles with a Line 
; Listing 7. Drawing a Line Between Circles 
 
;; 
(defun C:CONNECT () 
  (setq        EN1             (car (entsel "\nPick a circle: ")) 
        EN2             (car (entsel " and another: ")) 
        RCnt             (if RCnt 
                       (1+ RCnt) 
                       1 
                     ) 
        Connect_Flag 'T 
  ) 
  (if (and EN1 EN2) 
    (progn 
      (vl-load-com) 
      (setq EN3        (Connection EN1 EN2) 
            EN3        (vlax-ename->vla-object EN3) 
            EN1        (vlax-ename->vla-object EN1) 
            EN2        (vlax-ename->vla-object EN2) 
      ) 
      (vlr-object-reactor 
        (list EN1 EN2 EN3) 
        (strcat "Connect Circles " (itoa RCnt)) 
        '((:vlr-modified . ConnectFix) 
                                        ;(:vlr-erased . ConnectKill) 
         ) 
      ) 
    ) 
  ) 
) 
 
;; 
(defun Connection (EN1 EN2 / EL1 EL2) 
  (setq        EN1 (if        (= (type EN1) 'EName) 
              EN1 
              (vlax-vla-object->ename EN1) 
            ) 
        EN2 (if        (= (type EN2) 'Ename) 
              EN2 
              (vlax-vla-object->ename EN2) 
            ) 
        EL1 (entget EN1) 
        EL2 (entget EN2) 
        R1  (cdr (assoc 40 EL1)) 
        R2  (cdr (assoc 40 EL2)) 
        P1  (cdr (assoc 10 EL1)) 
        P2  (cdr (assoc 10 EL2)) 
        A1  (angle P1 P2) 
        P1  (polar P1 A1 R1) 
        P2  (polar P2 (+ A1 PI) R2) 
  ) 
  (entmake (list 
             '(0 . "LINE") 
             (assoc 8 EL1) 
             (cons 10 P1) 
             (cons 11 P2) 
           ) 
  ) 
  (entlast) 
) 
;Listing 8. Entity Object Callback Function 
 
;; 
(defun ConnectFix (Not_Obj 
                   ;;caused notification 
                   Re_Obj 
                   ;;reactor object 
                   PList 
                   ;;parameters list 
                   /          ObjList 
                   ;;objects in reactor set 
                   VObj 
                   ;;VLA object 
                   EN 
                   ;;Entity name 
                   EL 
                   ;;Entity list 
                   ENL 
                   ;;Entity list for line 
                   P1 
                   ;;Center/end point 1 
                   P2 
                   ;;Center/end point 2 
                   R1 
                   ;;Radius 1 
                   R2 
                   ;;Radius 2 
                   SkipIt 
                   ;;Process change flag 
                  ) 
  ;; 
  (if Connect_Flag 
    (progn 
      (setq Connect_Flag nil) 
      ;; 
      ;;Get list of objects associated with the 
      ;;reactor that caused the call back. 
      ;; 
      (setq ObjList (vlr-owners Re_Obj)) 
      ;; 
      ;;Loop through each object in list 
      (foreach VObj ObjList 
        ;; 
        ;;Convert object reference to AutoLISP style 
        (setq EN (vlax-vla-object->ename VObj) 
              EL (entget EN) 
        ) 
        (cond ;;what type of entity is it? 
              ((= (cdr (assoc 0 EL)) "LINE") 
               ;;Did the line object cause the callback? 
               (if (eq Not_Obj VObj) 
                 ;;if so, skip it. 
                 (setq SkipIt 'T) 
               ) 
               (setq ENL EL) 
               ;;save entity list of line 
              ) 
              ('T 
               ;;Otherwise it is one of the circles. 
               ;;get the center point and radius 
               (set (if        (boundp 'P1) 
                      'P2 
                      'P1 
                    ) 
                    (cdr (assoc 10 EL)) 
               ) 
               (set (if        (boundp 'R1) 
                      'R2 
                      'R1 
                    ) 
                    (cdr (assoc 40 EL)) 
               ) 
              ) 
        ) 
      ) 
      (setq AA        (angle P1 P2) 
            ;;angle between circles 
            ;;adjust points P1 and P2 
            P1        (polar P1 AA R1) 
            P2        (polar P2 (+ AA PI) R2) 
            ;;replace values in entity list 
            ENL        (subst (cons 10 P1) 
                       (assoc 10 ENL) 
                       ENL 
                ) 
            ENL        (subst (cons 11 P2) 
                       (assoc 11 ENL) 
                       ENL 
                ) 
      ) 
      (if (null SkipIt) 
        (progn 
          (entmod ENL) 
          ;;update the line 
        ) 
        (prompt "\nConnection broken.") 
      ) 
      (setq Connect_Flag 'T) 
    ) 
    ;;end PROGN 
  ) 
  ;;end IF 
)

http://xoutside.com/CAD/chair/lisp/num123/030327--123.htm

<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="700" id="AutoNumber1" height="498">
<tr>
<td width="100%" height="489">
<iframe name="I1" width="100%" height="100%" src="http://xoutside.com/CAD/chair/lisp/num123/030327--123.htm">
浏览器不支持嵌入式框架或配置为不显示嵌入式框架
</iframe>
</td>
</tr>
</table>

复制代码

<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="700" id="AutoNumber1" height="498">
<tr>
<td width="100%" height="489">
<iframe name="I1" width="100%" height="100%" src="http://cadence.advanstar.com/1999/0999/toolbox0999.html">
浏览器不支持嵌入式框架或配置为不显示嵌入式框架
</iframe>
</td>
</tr>
</table>

复制代码

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

[讨论]：正在学习反应器，请赐教

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子