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 :
(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.