This is the third post in my cycle about the table of annotative markers. First I'll give a recap of what I want my LISP to do.
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 have written the following routine that handles this task:
(setq MarkersInTable nil)
(setq oldentityMidpointList nil)
(vl-load-com)
(defun OldScaleInInches (reactorObject data / )
(if (= (strcase (car data)) "CANNOSCALE") (progn
(setq CANNOSCALE (getvar 'CANNOSCALE ))
(setq oldscale (ImperialScaleTruncator CANNOSCALE "="))
(setq oldscalefactor (Combined oldscale))
(TableBasepoint)
(oldscaleMarkers)
))
)
(defun NewScaleInInchesANDEVERYTHING (reactorObject data / )
(if (= (strcase (car data)) "CANNOSCALE") (progn
(setq CANNOSCALE (getvar 'CANNOSCALE ))
(setq newscale (ImperialScaleTruncator CANNOSCALE "="))
(setq newscalefactor (Combined newscale))
(setq conversionfactor (/ (float oldscalefactor) (float newscalefactor)))
(newscaleMarkerMidpoints)
))
)
(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))
)
(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
(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 oldentityMidpoint (nth j oldentityMidpointList))
(setq oldnewEntityMidpoint (test basePointList-2D oldentityMidpoint conversionfactor))
(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)
(vla-move entity oldentityMidpoint oldnewEntityMidpoint) ;This is the main move
(if (OR (= "AcDbHatch" (vla-get-objectname entity)) (= "AcDbPolyline" (vla-get-objectname entity))) (vla-ScaleEntity entity oldnewEntityMidpoint conversionfactor))
(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))
(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
)
(setq j (1+ j))
)
)
(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 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 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.
(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
(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))
)
(setq i (1+ i))
)
(setq oldentityMidpointList (reverse oldentityMidpointList))
)
(print "\nNo objects found inside the table border.")
)
(princ)
)
(print "\nNo block found on the specified layer.")
)
)
(defun ImperialScaleTruncator (txt separator / index result)
(setq index(vl-string-search separator txt))
(progn
(setq result (substr txt 1 index))
)
result
)
(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"...
(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))
)
(print "\nNo block found on the specified layer.")
)
)
;Reactor
(vlr-editor-reactor nil '((:VLR-sysVarWillChange . OldScaleInInches) (:VLR-sysVarChanged . NewScaleInInchesANDEVERYTHING)))
I know it is messy, has no "error handling" and so on, but it does actually work the way I want it to (even if sometimes I do not understand the reason for some of the parts I had to include, like the seccond corrective move I have to do for dimensions, cause otherwise they end up in the wrong place).
The only thing that is bothering me here, is the fact that this routine is not fully "undoable" - the AutoCAD undo does not work on it the way it should. What ends up happening, is that the elements are moved to points around twice as close to one another as they should be (photos attached). This of course does not happen when I manually set the scale back to the original one - in that case everything works just fine.
I have found the two vla-undo functions (vla-StartUndoMark and vla-EndUndoMark), but I do not fully understand them and cannot get them to work (I did manage to crash my CAD a couple of times though). How does one use these functions with reactors? The result I am after is of course for the undo command invoked by the user to completely undo the whole LISP - so that the whole drawing is in the exact state it was before the first reactor triggered.
I am also attaching the drawing I use to test the LISP.