Author Topic: Object Reactor - Modifying the owner  (Read 2878 times)

0 Members and 1 Guest are viewing this topic.

Xander

  • Guest
Object Reactor - Modifying the owner
« on: October 13, 2011, 02:07:07 AM »
I'm attempting to alter our current section drawing utilities to incorporate some change reactors etc. However I've reached a stand still...I can update one of the section flags using a modified reactor, but the other I cannot access.

Is it possible to modify the owner?

Alternatively I may have to modify the blocks to be the arrows only and draw the lines separately.

Note: (gtblocks:createsectionhead) simply creates a block and returns the block name.

Code: [Select]
(DEFUN gtsections:drawsection (/ $head $tail $headblock $tailblock $start $end $direction $flag $flip $combination $entityt $entityh)
    (SETQ $flag T)
    (SETQ $flip -1)

    (SETQ $head (gtblocks:createsectionhead))
    (SETQ $tail (gtblocks:createsectiontail))
    (SETQ $start (GETPOINT "\nSpecify start point: "))

    ;;Get head/tail positions
    (COMMAND "_.-insert" $head $start (GETVAR "dimscale") (GETVAR "dimscale") 0)
    (SETQ $headblock (VLAX-ENAME->VLA-OBJECT (ENTLAST)))
    (COMMAND "_.-insert" $tail $start (* -1 (GETVAR "dimscale")) (GETVAR "dimscale") 0)
    (SETQ $tailblock (VLAX-ENAME->VLA-OBJECT (ENTLAST)))


    (SETQ $combination 0)
    (WHILE $flag
        (SETQ g (GRREAD T))
        (COND
            ;;Exit
            ((= 3 (CAR g))
             (SETQ $flag nil)
            )

            ;;Mouse Move, rotate blocks
            ((= 5 (CAR g))
             (SETQ g (gtsections:orthogrread $start (CADR g)))
             (REDRAW)
             (GRDRAW $start g 1 1)
             (IF (= 1 $flip)
                 (gtsections:grdraw $headblock $tailblock (+ PI (ANGLE $start g)) g)
                 (gtsections:grdraw $headblock $tailblock (ANGLE $start g) g)
             )
            )

            ;;Keyboard Press (TAB)
            ((AND (= 2 (CAR g)) (= 9 (CADR g)))
             (SETQ $flip (* $flip -1))

             ;;(VLAX-PUT-PROPERTY $headblock 'rotation (+ (VLAX-GET-PROPERTY $headblock 'rotation) PI))
             (VLAX-PUT-PROPERTY $headblock 'XScaleFactor (* -1 (VLAX-GET-PROPERTY $headblock 'XScaleFactor)))
             ;;(VLAX-PUT-PROPERTY $tailblock 'rotation (+ (VLAX-GET-PROPERTY $headblock 'rotation) PI))
             (VLAX-PUT-PROPERTY $tailblock 'XScaleFactor (* -1 (VLAX-GET-PROPERTY $tailblock 'XScaleFactor)))

            )
            ;;Orthomode toggle
            ((AND (= 2 (CAR g)) (= 15 (CADR g)))
             (SETVAR 'orthomode (- 1 (GETVAR 'orthomode)))
            )

            ;;Right Click - Change symbol combinations
            ((= 11 (CAR g))
             (SETQ $combination (1+ $combination))
             (IF (< 3 $combination)
                 (SETQ $combination 0)
             )
             (COND
                 ;;Head/tail
                 ((= 0 $combination)
                  (VLAX-PUT-PROPERTY $headblock 'name "GT-Sect-Head")
                 )
                 ;;Head/head
                 ((= 1 $combination)
                  (VLAX-PUT-PROPERTY $tailblock 'name "GT-Sect-Head")
                 )
                 ;;Tail/Head
                 ((= 2 $combination)
                  (VLAX-PUT-PROPERTY $headblock 'name "GT-Sect-Tail")
                 )
                 ;;Tail/Tail
                 ((= 3 $combination)
                  (VLAX-PUT-PROPERTY $tailblock 'name "GT-Sect-Tail")
                 )
             )
            )
        )
    )
    (IF
        (AND $headblock $tailblock)
           (SETQ
               *object-reactor-headblock (VLR-OBJECT-REACTOR (LIST $headblock) $tailblock '((:VLR-MODIFIED . update-block)))
                 *object-reactor-tailblock (VLR-OBJECT-REACTOR (LIST $tailblock) $headblock '((:VLR-MODIFIED . update-block)))
           )
    )
    (PRINC)
)

;;Block 1 is the block modified, block 2 is the block to move
(DEFUN update-block (block1 reactor params / block2)
    (SETQ block2 (VLR-DATA reactor))
    (IF
        (AND
            (VLAX-READ-ENABLED-P block1)
            (VLAX-WRITE-ENABLED-P block2)
            (NOT (OR (VLAX-ERASED-P block1) (VLAX-ERASED-P block2)))
        )
           (PROGN
               (SETQ $point1 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block1 'insertionpoint)))
               (SETQ $point2 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block2 'insertionpoint)))
               (VLAX-PUT-PROPERTY block2
                                  'rotation
                                  (+ (ANGLE (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point1 0) (VLAX-SAFEARRAY-GET-ELEMENT $point1 1))
                                            (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point2 0) (VLAX-SAFEARRAY-GET-ELEMENT $point2 1))
                                     )
                                     PI
                                  )
               )
           )
    )
    (PRINC)
)

(DEFUN gtsections:grdraw ($head $tail $rotation $base / $entityh $entityt)
    (VLAX-PUT-PROPERTY $head 'rotation $rotation)
    (VLAX-PUT-PROPERTY $tail 'rotation $rotation)
    (VLA-PUT-INSERTIONPOINT $tail (VLAX-3D-POINT $base))
)

(DEFUN c:gttest ()
    (gtsections:drawsection)
)


(DEFUN gtsections:orthogrread (base point)
    (IF (ZEROP (GETVAR 'orthomode))
        point
        (APPLY 'POLAR
               (CONS base
                     (
                      (LAMBDA (n / a x z)
                          (SETQ x (- (CAR (TRANS point 0 n)) (CAR (TRANS base 0 n)))
                                z (- (CADDR (TRANS point 0 n)) (CADDR (TRANS base 0 n)))
                                a (ANGLE '(0. 0. 0.) n)
                          )
                          (IF (< (ABS z) (ABS x))
                              (LIST (+ a (/ PI 2.)) x)
                              (LIST a z)
                          )
                      )
                         (TRANS (GETVAR 'ucsxdir) 0 1)
                     )
               )
        )
    )
)

(DEFUN gtsections:absolutdistance ($start $end / $xdist $ydist)
    (SETQ $xdist (- (CAR $start) (CAR $end)))
    (SETQ $ydist (- (CADR $start) (CADR $end)))
    (IF (= 0 $ydist)
        $xdist
        (/ $xdist $ydist)
    )
)
« Last Edit: October 13, 2011, 02:41:25 AM by Xander »

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Object Reactor - Modifying the owner
« Reply #1 on: October 13, 2011, 08:40:33 AM »
Hi Xander,

One way to modify the owner of an object reactor within its own callback function is to disable the object reactor, create a command reactor with event 'commandended', then in the callback of the command reactor, perform the modification and re-enable the object reactor.

I follow this method in this program to restrict the user from modifying the centerlines themselves, perhaps it will help you.

Lee

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Object Reactor - Modifying the owner
« Reply #2 on: October 13, 2011, 08:41:03 AM »
Aside: would you not be better to create that functionality using a dynamic block?

Xander

  • Guest
Re: Object Reactor - Modifying the owner
« Reply #3 on: October 13, 2011, 09:01:13 AM »
Hi Xander,

One way to modify the owner of an object reactor within its own callback function is to disable the object reactor, create a command reactor with event 'commandended', then in the callback of the command reactor, perform the modification and re-enable the object reactor.

I follow this method in this program to restrict the user from modifying the centerlines themselves, perhaps it will help you.

Lee

Thanks, I'll have a look into it.

Aside: would you not be better to create that functionality using a dynamic block?
Ahh an easier approach. I've had a look at dynamic blocks, and while I like the feature set, where's the challenge?  :kewl:
Honestly the adoption of dynamic blocks is outside my control within the company scope.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Object Reactor - Modifying the owner
« Reply #4 on: October 13, 2011, 07:51:36 PM »
Xander, I don't see why wouldn't you define new command function that will modify both blocks consequently and assign reactor events to both blocks... To modify you just use defined command function, but not predefined commands for manipulation...
Here is an example :

Code: [Select]
(defun gtblocks:createsectionhead nil
  (entmakex '((0 . "LINE") (10 0.0 0.0 0.0) (11 1.0 0.0 0.0) (62 . 1) (210 0.0 0.0 1.0)) )
  (vl-cmdf "_.select" "L" "")
  (entmakex '((0 . "LINE") (10 0.0 0.0 0.0) (11 0.0 1.0 0.0) (62 . 3) (210 0.0 0.0 1.0)) )
  (vl-cmdf "_.select" "P" "L" "")
  (vl-cmdf "-block" "GT-Sect-Head" "0,0,0" (ssget "_P") "")
  (eval "GT-Sect-Head")
)

(defun gtblocks:createsectiontail nil
  (entmakex '((0 . "LINE") (10 0.0 0.0 0.0) (11 0.5 0.0 0.0) (62 . 1) (210 0.0 0.0 1.0)) )
  (vl-cmdf "_.select" "L" "")
  (entmakex '((0 . "LINE") (10 0.0 0.0 0.0) (11 0.0 0.5 0.0) (62 . 3) (210 0.0 0.0 1.0)) )
  (vl-cmdf "_.select" "P" "L" "")
  (vl-cmdf "-block" "GT-Sect-Tail" "0,0,0" (ssget "_P") "")
  (eval "GT-Sect-Tail")
)

(DEFUN gtsections:drawsection (/ $head $tail $headblock $tailblock $start $end $direction $flag $flip $combination $entityt $entityh)
    (SETQ $flag T)
    (SETQ $flip -1)

    (SETQ $head (gtblocks:createsectionhead))
    (SETQ $tail (gtblocks:createsectiontail))
    (SETQ $start (GETPOINT "\nSpecify start point: "))

    ;;Get head/tail positions
    (COMMAND "_.-insert" $head $start (GETVAR "dimscale") (GETVAR "dimscale") 0)
    (SETQ $headblock (VLAX-ENAME->VLA-OBJECT (ENTLAST)))
    (COMMAND "_.-insert" $tail $start (* -1 (GETVAR "dimscale")) (GETVAR "dimscale") 0)
    (SETQ $tailblock (VLAX-ENAME->VLA-OBJECT (ENTLAST)))

    (SETQ $combination 0)
    (WHILE $flag
        (SETQ g (GRREAD T))
        (COND
            ;;Exit
            ((= 3 (CAR g))
             (SETQ $flag nil)
            )

            ;;Mouse Move, rotate blocks
            ((= 5 (CAR g))
             (SETQ g (gtsections:orthogrread $start (CADR g)))
             (REDRAW)
             (GRDRAW $start g 1 1)
             (IF (= 1 $flip)
                 (gtsections:grdraw $headblock $tailblock (+ PI (ANGLE $start g)) g)
                 (gtsections:grdraw $headblock $tailblock (ANGLE $start g) g)
             )
            )

            ;;Keyboard Press (TAB)
            ((AND (= 2 (CAR g)) (= 9 (CADR g)))
             (SETQ $flip (* $flip -1))

             ;;(VLAX-PUT-PROPERTY $headblock 'rotation (+ (VLAX-GET-PROPERTY $headblock 'rotation) PI))
             (VLAX-PUT-PROPERTY $headblock 'XScaleFactor (* -1 (VLAX-GET-PROPERTY $headblock 'XScaleFactor)))
             ;;(VLAX-PUT-PROPERTY $tailblock 'rotation (+ (VLAX-GET-PROPERTY $headblock 'rotation) PI))
             (VLAX-PUT-PROPERTY $tailblock 'XScaleFactor (* -1 (VLAX-GET-PROPERTY $tailblock 'XScaleFactor)))

            )
            ;;Orthomode toggle
            ((AND (= 2 (CAR g)) (= 15 (CADR g)))
             (SETVAR 'orthomode (- 1 (GETVAR 'orthomode)))
            )

            ;;Spacebar - Change symbol combinations
            ((AND (= 2 (CAR g)) (= 32 (CADR g)))
             (SETQ $combination (1+ $combination))
             (IF (< 3 $combination)
                 (SETQ $combination 0)
             )
             (COND
                 ;;Head/tail
                 ((= 0 $combination)
                  (VLAX-PUT-PROPERTY $headblock 'name "GT-Sect-Head")
                 )
                 ;;Head/head
                 ((= 1 $combination)
                  (VLAX-PUT-PROPERTY $tailblock 'name "GT-Sect-Head")
                 )
                 ;;Tail/Head
                 ((= 2 $combination)
                  (VLAX-PUT-PROPERTY $headblock 'name "GT-Sect-Tail")
                 )
                 ;;Tail/Tail
                 ((= 3 $combination)
                  (VLAX-PUT-PROPERTY $tailblock 'name "GT-Sect-Tail")
                 )
             )
            )
        )
    )
    (IF
        (AND $headblock $tailblock)
           (SETQ
               *object-reactor-headblock (VLR-OBJECT-REACTOR (LIST $headblock) $tailblock '((:VLR-MODIFIED . update-block1)))
                 *object-reactor-tailblock (VLR-OBJECT-REACTOR (LIST $tailblock) $headblock '((:VLR-MODIFIED . update-block2)))
           )
    )
    (setq moross (ssadd))
    (ssadd (vlax-vla-object->ename $headblock) moross)
    (ssadd (vlax-vla-object->ename $tailblock) moross)
(PRINC)
)

;;Block 2 is the block modified, block 1 is the block to move
(DEFUN update-block2 (block1 reactor params / block2)
    (SETQ block2 (VLR-DATA reactor))
    (IF
        (AND
            (VLAX-READ-ENABLED-P block1)
            (VLAX-WRITE-ENABLED-P block2)
            (NOT (OR (VLAX-ERASED-P block1) (VLAX-ERASED-P block2)))
        )
           (PROGN
               (SETQ $point1 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block1 'insertionpoint)))
               (SETQ $point2 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block2 'insertionpoint)))
               (VLAX-PUT-PROPERTY block2
                                  'rotation
                                  (+ (ANGLE (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point1 0) (VLAX-SAFEARRAY-GET-ELEMENT $point1 1))
                                            (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point2 0) (VLAX-SAFEARRAY-GET-ELEMENT $point2 1))
                                     )
                                     0
                                  )
               )
           )
    )
    (PRINC)
)

;;Block 1 is the block modified, block 2 is the block to move
(DEFUN update-block1 (block2 reactor params / block1)
    (SETQ block1 (VLR-DATA reactor))
    (IF
        (AND
            (VLAX-READ-ENABLED-P block2)
            (VLAX-WRITE-ENABLED-P block1)
            (NOT (OR (VLAX-ERASED-P block1) (VLAX-ERASED-P block2)))
        )
           (PROGN
               (SETQ $point1 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block1 'insertionpoint)))
               (SETQ $point2 (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY block2 'insertionpoint)))
               (VLAX-PUT-PROPERTY block1
                                  'rotation
                                  (+ (ANGLE (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point2 0) (VLAX-SAFEARRAY-GET-ELEMENT $point2 1))
                                            (LIST (VLAX-SAFEARRAY-GET-ELEMENT $point1 0) (VLAX-SAFEARRAY-GET-ELEMENT $point1 1))
                                     )
                                     PI
                                  )
               )
           )
    )
    (PRINC)
)

(DEFUN gtsections:grdraw ($head $tail $rotation $base / $entityh $entityt)
    (VLAX-PUT-PROPERTY $head 'rotation $rotation)
    (VLAX-PUT-PROPERTY $tail 'rotation $rotation)
    (VLA-PUT-INSERTIONPOINT $tail (VLAX-3D-POINT $base))
)

(DEFUN gtsections:orthogrread (base point)
    (IF (ZEROP (GETVAR 'orthomode))
        point
        (APPLY 'POLAR
               (CONS base
                     (
                      (LAMBDA (n / a x z)
                          (SETQ x (- (CAR (TRANS point 0 n)) (CAR (TRANS base 0 n)))
                                z (- (CADDR (TRANS point 0 n)) (CADDR (TRANS base 0 n)))
                                a (ANGLE '(0. 0. 0.) n)
                          )
                          (IF (< (ABS z) (ABS x))
                              (LIST (+ a (/ PI 2.)) x)
                              (LIST a z)
                          )
                      )
                         (TRANS (GETVAR 'ucsxdir) 0 1)
                     )
               )
        )
    )
)

(DEFUN gtsections:absolutdistance ($start $end / $xdist $ydist)
    (SETQ $xdist (- (CAR $start) (CAR $end)))
    (SETQ $ydist (- (CADR $start) (CADR $end)))
    (IF (= 0 $ydist)
        $xdist
        (/ $xdist $ydist)
    )
)

(DEFUN c:moro ( / blss bl1 bl2 )
  (while (null blss)
    (prompt "\nPick block to MORO")
    (setq blss (ssget "_+.:E:S" '((0 . "INSERT")) ))
  )
  (setq morosss (ssadd))
  (ssadd (ssname moross 0) morosss)
  (ssadd (ssname moross 1) morosss)
  (setq bl1 (ssname blss 0))
  (vl-cmdf "_.move" bl1 "" "\\" "\\")
  (setq bl2 (ssname (ssdel bl1 morosss) 0))
  (vl-cmdf "_.move" bl2 "" "0,0,0" "0,0,0")
(princ)
)
 
(DEFUN c:gttest () (vl-load-com)
    (alert "\nPress <Tab> to Flip, <Space> to Switch Head/Tail combination, <F8> to change Orthomode\nAfter creation use command \"MORO\"")
    (gtsections:drawsection)
    (redraw)
)

BTW. My ACAD don't recognize return key value of grread for right mouse click event, so I modified your assignment and instead assign Spacebar key for switching Head/Tail blocks combinations...

Regards,
M.R.
« Last Edit: October 14, 2011, 05:50:51 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: Object Reactor - Modifying the owner
« Reply #5 on: October 13, 2011, 09:11:13 PM »
You should know, entmakex returns the ename. There's no reason to fuss with the select command as you are, just ssadd each to a selection set if you want to feed them to the block command.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox