An AutoCAD LISP routine that moves objects based on the annotative scale

Question

A little bit of background: I am creating a template for my team of drafters to use. We have a set of commonly used objects (les't call them "markers"), like section markers, leaders, dimensions, title blocks, etc. all set up in a table (not a real "Table", just arranged neatly in a rectangle). All of the markers are annotative, so that we do not need a separate set of markers for each os the scales that we work on.

Now we come to the problem: Although the markers, being annotative, scale properly when the annotation scale is changed, they all scale around their own basepoints (as they should). The problem is, that if these markers get too big due to the scale changes, they start to overlap so heavily, that they become totally unusable. I would like for them to move away from one another, so that they maintain their relative distances unchanged. In other words, I kinda want the whole table to behave like it is annotative. I know that it would be easy to solve by just making the whole table into an annotative block, but the markers need to be easily accessible for the drafters to use. I don't want them to have to explode the table-block each time they need to take a marker, or to have to go inside of this block, copy the markers they want, come out of the block and only then use them.

I tried to come up with a set of steps that would result in this behavior I want and this is what I think the LISP should do everytime the annotative scale is changed in the model space:

1. Get the centerpoint of the table border (which would itself be an annotative block, so that it properly encloses the "scaled-up" table in every scale).
2. Determine which objects are inside of the border (determine all the markers that are to be moved).
3. Measure the distance between this centerpoint of the border and the basepoints of all of the objects that are inside the border (the markers).
4. Scale this distance and move each marker in the same direction it is already "facing" with regard to the centerpoint, so that the new distance (in the new scale) is equal to this scaled distance. The scale factor of the distance would be based on the current and the new chosen scale (so if I was in 1:10 scale initially and change the scale to 1:1000, the distance grows by a factor of 100).
5. I don't want the LISP to prompt user for anything, it should run whenever the scale is changed, realise from which scale to which the change ocurred; and apply the position changes on the markers automatically.

Here's the link to an image showcasing the simplified version of the problem:
https://i.stack.imgur.com/RU70f.png
You can see the various markers inside of the orange table border. The border in the picture is selected, so that its basepoint is visible (I think it might be easiest to use this basepoint as the centerpoint around which the whole table "scales")

If anything is unclear or anyone needs additional info, please ask. And please help me

EDIT: I should probably add that I know pretty much nothing about writing LISPS (or programming in general for that matter), so if You could be as explicit as You can in Your answers, I would really appriciate that.

EDIT 2: I started to learn about AutoLISP and reactors in particular. I've written the following code as a start:

(vlr-sysvar-reactor
  "CANNOSCALEVALUE"
  '((:vlr-sysvarchanged . MoveMarkersOnScaleChange))
)

(defun MoveMarkersOnScaleChange (calling-reactor :vlr-sysVarChanged)
  (princ "Hello")
)

From what I understand, this should simply print "Hello" in the command line each time the scale is changed (the CANNOSCALEVALUE variable changes). It kinda works like that, but I noticed that once the .lsp is loaded into my file, it starts to print "Hello" after pretty much everything I do (like draw a polyline, move something and so on), not only after the scale change (though that works as well). Sometimes it even prints in a rapid succession (HelloHelloHello, etc.). Could someone enlighten me as to what is going on here...?
I suspect it has something to do with the part(calling-reactor :vlr-sysVarChanged), cause this is the only part of the code I do not really get. And yes, I know that:

"Callback functions for all reactors, other than Object reactors, must be defined to accept two arguments:
The first argument identifies the Reactor object that called the function.
The second argument is a list of parameters set by AutoCAD."

but I do not really know what it means, so it's not much help.

Answer 1

You can capture event of change annotation scale by reactor ( vlr-sysvar-reactor data functionToRun ) let it watch variable CANNOSCALE like this:

(defun OnSysvarChanged (reactorObject dane / )
    (if (= (strcase (car dane)) "CANNOSCALE") (progn 
        (setq CANNOSCALE (getvar 'CANNOSCALE ))
        (setq scaledata (String:Split CANNOSCALE ":"))
        (setq scalefactor (/ (atof (car scaledata) ) (atof (cadr scaledata))))
        (print scalefactor)
    ))
)
    
(defun String:Split (txt separator / index result)
    (setq index(vl-string-search separator txt))
    (while index
      (progn
        (setq result (append result (list(substr txt 1 index))))
        (setq txt (substr txt (+ index 1 (strlen separator))))
        (setq index(vl-string-search separator txt))
      )
    )
    (setq result (append result (list txt)))
    result
   )
   
    (vlr-editor-reactor nil '((:VLR-sysVarChanged . OnSysvarChanged)))

The center point of table You can get like this.

I don't know how You identify table - to simplify let's assume we have a handle to it so:

(setq frame (handent "24E" ))
(setq bbox (BoundingBox:Get frame ) )
(setq center (BoundingBox:Center bbox))
(print center)

(defun BoundingBox:Get (object / ) 
    (cond 
      ( (null object) nil)
      ( (=(type object) 'ENAME ) (BoundingBox:Get (vlax-ename->vla-object object)))
      ( (=(type object) 'VLA-OBJECT ) ( progn 
        (vla-GetBoundingBox object 'minpoint 'maxpoint)
        (list (cons 'MIN (list(List:Factory minpoint ))) (cons 'MAX (list(List:Factory maxpoint))
      ) )
      ) )
      ( t nil )
    )
)


(defun BoundingBox:Center (bbox / )
  (cond 
    ( (null bbox) nil)
    ( (or (not(listp bbox)) (/=(length bbox) 2) ) nil)
    ( (or (null (assoc 'MIN bbox )) (null (assoc 'MAX bbox ) ) ) nil )
    ( t (progn 
        (setq minpoint (cadr (assoc 'MIN bbox)) 
              maxpoint (cadr (assoc 'MAX bbox)) )
        (Point:Calculate:Middle minpoint maxpoint)
    ) )
  )
)

(defun Point:Calculate:Middle ( p1 p2 / )
    (mapcar '(lambda (a b ) (+ a (* (- b a ) 0.5))) p1 p2)
)

(defun List:Factory (InVal / OutVal AsList result i )   
    (cond 
        ( ( = (type InVal) nil) nil)
        ( (vl-catch-all-error-p InVal) (progn (princ "Error trapped:" ) (princ InVal ) nil))
        ( ( = (type InVal) 'LIST) InVal)
        ( ( = (type InVal) 'SAFEARRAY) (progn           
            (setq AsList (vl-catch-all-apply 'vlax-safearray->list (list InVal )))
            (if (vl-catch-all-error-p AsList)   ( progn
                ( princ (vl-catch-all-error-message AsList ) )
                nil
              )  ( progn 
                AsList
            ) )
        ) )
        ( ( = (type InVal) 'VARIANT) (progn 
            (List:Factory (vlax-variant-value InVal) )
        ) )
        ( (= (type InVal) 'PICKSET ) (progn
            (setq i 0 )
            (repeat (sslength InVal)
                (setq result (append result (list (vlax-ename->vla-object(ssname InVal i)))))
                (setq i (1+ i ) )
            )
            result
        ) )
        ( t (list InVal ) )
    )
)

If the rectangle frame is on specified layer, and You are sure nothing else is on this layer You can use (ssget "X" (list(cons 8 "TABLE BORDER") )) to select it.

(defun Select:ByLayer ( layerName / coords )
    (List:Factory (ssget "X" (list(cons 8 layerName) )))
)

(setq frame (car(Select:ByLayer "TABLE BORDER") )) 

To select everything inside the frame You can use such code:

(defun Select:ByFrame ( frame / coords )
    (setq coords (CoordinatesReader:Get frame ) )   
    (List:Factory (ssget "WP" coords))
)


(defun CoordinatesReader:Get ( object / coords )
  (cond 
    ( (null object ) nil )
    ( (= (type object) 'ENAME ) (CoordinatesReader:Get (vla-ename->vlax-object object)))
    ( (= (type object) 'VLA-OBJECT  ) (progn 
        (setq coords (List:Factory ( vlax-get-property object 'Coordinates ) )  )       
        (mapcar '(lambda ( a ) (append a (list 0.0 ) ) ) (List:Split coords 2) )
    ))
  )
)

(defun List:Split (In Len / l i j SubList result )
    (setq l (length In ))
    (setq i 0 ) 
    (while (< i l) 
        (setq SubList nil )
        (setq j 0) 
        (while (< j Len )
            (setq SubList (append SubList (list(nth (+ i j) In ) )))
            (setq j (1+ j ))
        )
        (setq result (append result (list SubList)))
        (setq i (+ i Len ))
    )
    result
)

Answer 2

If anyone is interested, I think I have solved the whole problem. The whole code is below. There is quite a lot that is not strictly necessary for the LISP to work (like test functions or sometimes funny comments), but I left it all in, since (as I am still a beginner) I want to be able to go back to this often and be able to draw inspiration from it (see what worked, what didn't, why I finally did something the way I did, etc.). Of course I would still appreciate any optimizations or alternatives to my solutions.

;IMPORTANT - THE TABLE BORDER REALLY HAS TO BE ON THE CORRECT LAYER AND BE A BLOCK (THE ONLY ONE THERE) WITH A BASEPOINT IN ITS CENTER

;Global variables
;(setq oldscale nil)
;(setq newscale nil)
;(setq oldscalefactor 1)
;(setq newscalefactor 1)
(setq MarkersInTable nil)
(setq oldentityMidpointList nil)

(vl-load-com)

;-----------------------------------------------------------IMPORTANT-PART-----------------------------------------------------------
;Old scale and selecting the objects in table
(defun OldScaleInInches (reactorObject data / )
    (if (= (strcase (car data)) "CANNOSCALE") (progn 
        (setq CANNOSCALE (getvar 'CANNOSCALE ))
        (setq oldscale (ImperialScaleTruncator CANNOSCALE "="))
        (setq oldscalefactor (Combined oldscale))
        ;(print oldscale)
        ;(setq oldPrint (strcat "Old Scale Factor was: " (rtos oldscalefactor))) (print oldPrint) ;This just prints the oldscalefactor
        (TableBasepoint)
        (oldscaleMarkers)
    ))
)

;-----------------------------------------------------------IMPORTANT-PART-----------------------------------------------------------
;New scale and almost everything else (moving markers etc.)
(defun NewScaleInInchesANDEVERYTHING (reactorObject data / )
    (if (= (strcase (car data)) "CANNOSCALE") (progn 
        (setq CANNOSCALE (getvar 'CANNOSCALE ))
        (setq newscale (ImperialScaleTruncator CANNOSCALE "="))
        (setq newscalefactor (Combined newscale))
        ;(print newscale)
        ;(setq newPrint (strcat "New Scale Factor is: " (rtos newscalefactor))) (print newPrint) ;This just prints the newscalefactor
        (setq conversionfactor (/ (float oldscalefactor) (float newscalefactor)))
        ;(setq conversionPrint (strcat "Conversion Factor is: " (rtos conversionfactor))) (print conversionPrint) ;This just prints the conversionfactor
        ;(print tableBaseToPrint) ; This just prints the table basepoint
        ;(TestLine xCoord conversionfactor) ; This is a test-function that draws a line from (0 0 0) to (xCoord conversionfactor 0)
        ;(tableBorderTestRect)
        

      ;(if (> conversionfactor 1) (newscaleMarkerMidpointsS2B) (newscaleMarkerMidpointsS2B))
      (newscaleMarkerMidpoints)

        
    ))
)
;-----------------------------------------------------------IMPORTANT-PART-----------------------------------------------------------



(defun test (pointA pointB factor / Ax Ay Bx By)

  (setq Ax (car pointA))
  (setq Ay (cadr pointA))
  (setq Bx (car pointB))
  (setq By (cadr pointB))

  (setq Cx (+ Ax (* factor (- Bx Ax))))
  (setq Cy (+ Ay (* factor (- By Ay))))

  (setq pointC (list Cx Cy 0.0))

  ;(print pointC)

)

(defun newscaleMarkerMidpoints (/)


  (if MarkersInTable
      (progn
        (setq j 0)
        (while (setq ename (ssname MarkersInTable j))
          (setq entity (vlax-ename->vla-object ename))
          (setq entityLayer (vla-get-Layer entity)) ; Get the layer of the entity

          ; Check if the entity's layer matches the table border layer name
          ;(if (not (= oldentityLayer "TABLE (NON-PRINTABLE) -NOVA")) ; This deals with the table being in the selection set. NO IT DOESN'T. It still technically is in the set, but none of the commands apply to it. IT CAUSED THE WHOLE MESS WITH INDEXES
              (progn
                (setq coordinates (vla-getboundingbox entity 'minPTmark 'maxPTmark))
                (setq minPTmark (vlax-safearray->list minPTmark))
                (setq maxPTmark (vlax-safearray->list maxPTmark))
                (setq entityMidpoint (list (/ (+ (car minPTmark) (car maxPTmark)) 2.0) (/ (+ (cadr minPTmark) (cadr maxPTmark)) 2.0) 0.0))
                (setq basePointList-2D (list xCoord yCoord))
                (setq newEntityMidpoint (test basePointList-2D entityMidpoint conversionfactor))

                ;(setq listlength (length oldentityMidpointList)) ;THIS WHOLE THING WITH THE FUCKED UP INDEXES WAS BECAUSE I HAD THE TABLE BORDER SELECTED AS WELL...
                ;(setq oldentityMidpoint (if (or (= j listlength) (= j (- listlength 1))) ;I have no idea why I have to do it but here it is. Without this it for some reason skips the penultimate point on the list, goes straight for the last one and then tries to process the one after that, which of course does not exist and thus returns an error (which stops the rest of the execution). I told it to print values of j after each loop an it actually goes like (0 1 2 4 nil) on a 5-item list... So this code basically tells it to take a value of j-1 if it is at the penultimate or the ultimate item on the list. LOOK ABOVE FOR EXPLANATION
                ;            (nth (- j 1) oldentityMidpointList)
                ;            (nth j oldentityMidpointList)))

                (setq oldentityMidpoint (nth j oldentityMidpointList))

                ;(print j) ;TEST
                ;(print listlength) ;TEST
                ;(print oldentityMidpoint) ;TEST
                ;(print oldentityMidpointList) ;TEST
                (setq oldnewEntityMidpoint (test basePointList-2D oldentityMidpoint conversionfactor))
                ;(print oldnewEntityMidpoint) ;TEST

                ;(testrect minPTmark maxPTmark) ;TEST
                ;;(TestLine2 entityMidpoint newEntityMidpoint) ;TEST

                ;(TestLine2 entityMidpoint oldentityMidpoint) ;TEST

                (vla-move entity entityMidpoint oldentityMidpoint) ;This is a corrective move (back from the midpoint obtained after scaling to the one the entity had before it)


                ;(TestLineRED oldentityMidpoint oldnewEntityMidpoint) ;TEST

                (vla-move entity oldentityMidpoint oldnewEntityMidpoint) ;This has to get 3D points. This is the main move
               
                ;(if (= "AcDbMText" (vlax-get-property entity 'Objectname))
                ;  (progn
                    ;(print (vla-get-width entity))
                ;    (vla-put-width entity (* (vla-get-width entity) conversionfactor))
                    ;(print (vla-get-width entity))
                ;  )
                ;)

                ;(print (vla-get-objectname entity)) ;TEST

                (if (OR (= "AcDbHatch" (vla-get-objectname entity)) (= "AcDbPolyline" (vla-get-objectname entity))) (vla-ScaleEntity entity oldnewEntityMidpoint conversionfactor))
                ;(if (= "AcDbRotatedDimension" (vla-get-objectname entity)) (progn
                (setq coordinates (vla-getboundingbox entity 'minPTdim 'maxPTdim))
                (setq minPTdim (vlax-safearray->list minPTdim))
                (setq maxPTdim (vlax-safearray->list maxPTdim))
                (setq dimMidpoint (list (/ (+ (car minPTdim) (car maxPTdim)) 2.0) (/ (+ (cadr minPTdim) (cadr maxPTdim)) 2.0) 0.0))

                ;(testrectBLUE minPTdim maxPTdim) ;TEST

                (vla-move entity dimMidpoint oldnewEntityMidpoint) ; This is a corrective move, mainly for dimensions - for the rest of the markers it seems to do nothing (dimMidpoint = oldnewEntityMidpoit), but I kept it for all objects just in case

                ;(TestLineBLUE dimMidpoint oldnewEntityMidpoint) ;TEST

                ;))

                ;(vlax-dump-object entity) ;TEST

              )
          ;)
          (setq j (1+ j))
        )
        ;(print oldentityMidpointList) ;TEST
      )
      (print "\nNo objects found inside the table border.")
    )
)



(defun oldscaleMarkers (/) ; This extracts the coordinates of two opposite points of the table border and creates a rectangle based on them; and later selects all object inside this rectangle
  (setq oldentityMidpointList nil) ; Initialize the list here
  ;(setq MarkersInTable nil) ; Reset MarkersInTable to nil

  (setq tableBorder (ssget "X" (list (cons 8 "TABLE (NON-PRINTABLE) -NOVA"))))
  (if (setq ename (ssname tableBorder 0))
    (progn
      (setq tableBorder (vlax-ename->vla-object ename))

      (setq coordinates (VLA-GETBOUNDINGBOX tableBorder 'minPT 'maxPT)) ; The 'minPT and 'maxPT are output variables returned as a sefearray (I don't know why they are specified in that particular case)
      (setq minPT (vlax-safearray->list minPT)) ; This converts the minPT of a table border to a readable list
      (setq maxPT (vlax-safearray->list maxPT)) ; This converts the maxPT of a table border to a readable list
      ;(setq minPTy (+ (float (cadr minPT)) (float 0.01829))) ; The point here is to make the actual bounding box a bit smaller than the table border, so that the border is NOT selected along with the objects inside. This weird number has been derived experimentally (the smaller ones just don't work) and I havee NO IDEA why it is what it is...
      ;(print minPTy)
      ;(setq minPTx (car minPT))
      ;(setq minPT (list (float minPTx) (float minPTy)))     
      ;(print minPT)
      ;(print maxPT)

      (setq MarkersInTable (ssget "_W" minPT maxPT '((8 . "~TABLE (NON-PRINTABLE) -NOVA")))) ; THIS DEALS WITH THE EXCLUSION OF THE TABLE BORDER FROM THE SELECTION THE PROPER WAY.

      ;(print (sslength MarkersInTable)) ;TEST


      (if MarkersInTable
      (progn
        (setq i 0)
        (while (setq ename (ssname MarkersInTable i))
          (setq oldentity (vlax-ename->vla-object ename))
          (setq oldentityLayer (vla-get-Layer oldentity)) ; Get the layer of the entity

          ; Check if the entity's layer matches the table border layer name
          ;(if (not (= oldentityLayer "TABLE (NON-PRINTABLE) -NOVA")) ; This deals with the table being in the selection set. NO IT DOESN'T. It still technically is in the set, but none of the commands apply to it. IT CAUSED THE WHOLE MESS WITH INDEXES
              (progn
                (setq oldcoordinates (vla-getboundingbox oldentity 'oldminPTmark 'oldmaxPTmark))
                (setq oldminPTmark (vlax-safearray->list oldminPTmark))
                (setq oldmaxPTmark (vlax-safearray->list oldmaxPTmark))
                (setq oldentityMidpoint (list (/ (+ (car oldminPTmark) (car oldmaxPTmark)) 2.0) (/ (+ (cadr oldminPTmark) (cadr oldmaxPTmark)) 2.0) 0.0))

                (setq oldentityMidpointList (cons oldentityMidpoint oldentityMidpointList))

                ;(testrectRED oldminPTmark oldmaxPTmark) ;TEST
                ;(print oldentityMidpointList) ;TEST
 
                

              )
          ;)
          (setq i (1+ i))
        )
        (setq oldentityMidpointList (reverse oldentityMidpointList))
        ;(print oldentityMidpointList) ;TEST
      )
      (print "\nNo objects found inside the table border.")
    )




      ;(testrect minPT maxPT) ;TEST
      (princ)
    )

    (print "\nNo block found on the specified layer.")
  )
)


(defun testrect (start-point end-point) ;This creates a rectangle with two given points
  (setq rect-list
        (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4) ; Number of vertices
         (cons 10 start-point)
         (cons 10 (list (car start-point) (cadr end-point)))
         (cons 10 end-point)
         (cons 10 (list (car end-point) (cadr start-point)))
         '(70 . 1) ; Closed polyline
        )
  )
  (entmake rect-list)
)



;Extracting the first part of the imperial scale
(defun ImperialScaleTruncator (txt separator / index result)
    (setq index(vl-string-search separator txt))
      (progn
        (setq result (substr txt 1 index))
      )
    result
   )

;Setting the scale factors
(defun Combined (scale /)

  (cond
    ((or (and (/=(vl-string-search "/" scale) nil) (=(vl-string-search "-" scale) nil)) (and (/=(vl-string-search "/" scale) nil) (/=(vl-string-search "-" scale) nil))) (Hard scale)) 
    ((or (and (=(vl-string-search "/" scale) nil) (/=(vl-string-search "-" scale) nil)) (and (=(vl-string-search "/" scale) nil) (=(vl-string-search "-" scale) nil))) (Easy scale))
  )

)

(defun Easy (scaleE /)
  (cond
    ((and (=(vl-string-search "/" scaleE) nil) (/=(vl-string-search "-" scaleE) nil)) (*(atoi (chr (car (vl-string->list scaleE)))) 12))
    ((and (=(vl-string-search "/" scaleE) nil) (=(vl-string-search "-" scaleE) nil)) (atoi (chr (car (vl-string->list scaleE)))))
  )
)

(defun Hard (scaleH / x y xindex ystartindex ylength)

(setq xindex (- (vl-string-search "/" scaleH) 1))
(setq ystartindex (+ (vl-string-search "/" scaleH) 1))
(setq ylength (- (vl-string-search "\"" scaleH)  ystartindex)) ; The escape character ("\") is NOT counted when determining indexes
(setq x (atoi(substr scaleH (+ xindex 1) 1))) ; I have to add 1 to the xindex, cause FOR SOME STUPID REASON substr starts counting from "1", while everything else starts from "0"...
(setq y (atoi(substr scaleH (+ ystartindex 1) ylength))) ; I have to add 1 to the xindex, cause FOR SOME STUPID REASON substr starts counting from "1", while everything else starts from "0"...

;(print xindex) (print ystartindex) (print ylength) (print x) (print y) ; This is just here to print the intermediate steps of calculations. It is not necessary for the code to work, but it helps with debugging

  (cond
    ((and (/=(vl-string-search "/" scaleH) nil) (=(vl-string-search "-" scaleH) nil)) (/ (float x) (float y))) ; In division at least one number has to have a decimal expansion, in order for the result to not be an integer. That's why there's (float x) instead of just x
    ((and (/=(vl-string-search "/" scaleH) nil) (/=(vl-string-search "-" scaleH) nil)) (+ (atoi (chr (car (vl-string->list scaleH)))) (/ (float x) (float y)))) ; In division at least one number has to have a decimal expansion, in order for the result to not be an integer. That's why there's (float x) instead of just x
  )
)

(defun TableSelect(/) ; This selects the table border
(ssget "X" (list (cons 8 "TABLE (NON-PRINTABLE) -NOVA"))) ; IF THE LAYER OF THE BORDER EVER CHANGES IT HAS TO BE UPDATED HERE
)

(defun TableBasepoint (/) ; This gives me the coordinates of the table border's basepoint
  (setq tableBorder (TableSelect))
  (if (setq ename (ssname tableBorder 0))
    (progn
      (setq tableBorder (vlax-ename->vla-object ename))
      (setq basePoint (vlax-get-property tableBorder 'InsertionPoint)) ; This gives me the basepoint as a so called "safearray". So it does kinda work, but the coordinates are not readable
      (setq basePointList (vlax-safearray->list basePoint)) ; This creates a readable list out of the safearray (the list looks like this: (x y z))
      (setq xCoord (car basePointList))
      (setq yCoord (cadr basePointList))
      (setq zCoord (caddr basePointList))
      (setq tableBaseToPrint (strcat "TABLE BORDER base point coordinates: X = " (rtos xCoord) ", Y = " (rtos yCoord) ", Z = " (rtos zCoord)))
    )
    (print "\nNo block found on the specified layer.")
  )
)

;(defun TestLine (xTestLineEnd yTestLineEnd /)
;
;(setq LineEnd (list xTestLineEnd yTestLineEnd 0))
;
;(entmake (list (cons 0 "LINE") ; Object type
;  (cons 11 LineEnd)
;  (cons 10 '(0 0 0))
;  )
;)
;(princ)
;
;)

(defun TestLine2 (TestLine2Start TestLine2End /)

(entmake (list (cons 0 "LINE") ; Object type
  (cons 11 TestLine2End)
  (cons 10 TestLine2Start)
  )
)
(princ)

)

(defun TestLineRED (TestLine2Start TestLine2End /)

(entmake (list (cons 0 "LINE") ; Object type
  (cons 11 TestLine2End)
  (cons 10 TestLine2Start)
  (cons 62 1)
  )
)
(princ)

)



(defun testrectRED (start-point end-point) ;This creates a rectangle with two given points
  (setq rect-list
        (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4) ; Number of vertices
         (cons 10 start-point)
         (cons 10 (list (car start-point) (cadr end-point)))
         (cons 10 end-point)
         (cons 10 (list (car end-point) (cadr start-point)))
         '(70 . 1) ; Closed polyline
         (cons 62 1)
        )
  )
  (entmake rect-list)
)

(defun TestLineBLUE (TestLine2Start TestLine2End /)

(entmake (list (cons 0 "LINE") ; Object type
  (cons 11 TestLine2End)
  (cons 10 TestLine2Start)
  (cons 62 5)
  )
)
(princ)

)



(defun testrectBLUE (start-point end-point) ;This creates a rectangle with two given points
  (setq rect-list
        (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4) ; Number of vertices
         (cons 10 start-point)
         (cons 10 (list (car start-point) (cadr end-point)))
         (cons 10 end-point)
         (cons 10 (list (car end-point) (cadr start-point)))
         '(70 . 1) ; Closed polyline
         (cons 62 5)
        )
  )
  (entmake rect-list)
)




;Reactor
(vlr-editor-reactor nil '((:VLR-sysVarWillChange . OldScaleInInches) (:VLR-sysVarChanged . NewScaleInInchesANDEVERYTHING)))