This is a follow-up question to the one I asked a while ago (An AutoCAD LISP routine that moves objects based on the annotative scale). Since that one I've been learning AutoLISP and have come up with a code, but it I am stuck on the last step - actually moving the objects. But first things first:
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.
As I've already mentioned, I did lots of research and managed to come up with the following code:
;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)
(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)
(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))
(print pointC)
)
(defun newscaleMarkerMidpoints (/)
(if MarkersInTable
(progn
(setq i 0)
(while (setq ename (ssname MarkersInTable i))
(setq entity (vlax-ename->vla-object ename))
(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)))
(setq basePointList-2D (list xCoord yCoord))
(setq newEntityMidpoint (test basePointList-2D entityMidpoint conversionfactor))
;(testrect minPTmark maxPTmark) ;TEST
;(TestLineRED entityMidpoint newEntityMidpoint) ;TEST
;NONE OF THE TWO BELOW WORKS
;(vla-move entity entityMidpoint newEntityMidpoint)
;(MoveEntityFromOLDtoNEWmidpoint entity entityMidpoint newEntityMidpoint)
(setq i (1+ i))
)
)
(print "\nNo objects found inside the table border.")
))
(defun MoveEntityFromOLDtoNEWmidpoint (ent oldMidpoint newMidpoint / entityObj startPoint displacement)
(setq entityObj (vlax-ename->vla-object ent)) ; Get the entity as a VLA object
(setq displacement (vlax-3d-point (- (vlax-get newMidpoint 'x) (vlax-get oldMidpoint 'x))
(- (vlax-get newMidpoint 'y) (vlax-get oldMidpoint 'y))
0)) ; Calculate the displacement vector between A and B
(vla-move entityObj oldMidpoint displacement) ; Move the entity using VLA functions
(princ "\nEntity moved successfully.")
)
;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 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 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))
;(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)
)
;Reactor
(vlr-editor-reactor nil '((:VLR-sysVarWillChange . OldScaleInInches) (:VLR-sysVarChanged . NewScaleInInchesANDEVERYTHING)))
Here's a quick explanation of everything in the code above (it is important to note, that (sadly) I work in imperial units):
On the :VLR-sysVarWillChange event:
- it extracts the scale before the change and converts it to a number, which will be used later to calculate the conversion factor
- it finds the entity on the specified layer (a rectangle (table border) in an annotative block) and extracts its insertion point
- it selects all of the markers that are inside of the table by using the
ssgetandVLA-GETBOUNDINGBOX(btw, if anyone has any idea of how to solve the issue of the table border being included in the selection set in a more elegant manner than I did it, please let me know)
On the :VLR-sysVarChanged event:
- it extracts the scale after the change and converts it to a number, which will be used later to calculate the conversion factor
- it calculates the conversion factor
- it goes through every entity selected in the previous event (everything in the table) and determines their "midpoints"
- based on these midpoints, the insertion point (the middle) of the table obtained in the previous event and the conversion factor it performs a linear interpolation to get the point to which each individual marker should be moved (if the scale changed in such a way that the markers annotatively "grew" by a factor of 2, the new point will be twice as far from the middle of the table)
Literally the only thing left is to actually move each marker from its original point to the one that was interpolated.
I do of course know that this piece of code is terrible in terms of structure, function names, coding practices and so on, but I am quite proud of it, since it actually works and does almost everything I want it to. That said, I've been trying for the past day to make it finally move the selected markers, but I get errors (when I use the vla-move it gives me this: ActiveX server returned an error: An exception occured and when I try to use the MoveEntityFromOLDtoNEWmidpoint function (suggested by chatGPT) it gives me something like this Argument type error: lentityp #<VLA-OBJECT IGcadBlockReference 00000179F44536E0>. All of the markers are annotative blocks, so from what I understand they should be movable using vla-move.
Below is the link to the dwg file I use to test the LISP:
https://drive.google.com/file/d/1sTH13aNvJWyTDLLktZWxxliHVMLHkKLr/view?usp=sharing
If You have any questions, please ask.
EDIT: This particular problem was solved (I had to pass 3D points to the vla-move instead of the 2D ones I had), but I already have a new issue.
I have a problem of the moved markers not returning to their exact original position after the scale is changed first from X to Y and then from Y to X again - they drift a bit and this sometimes leads to them not being in the table anymore, which breaks the whole thing (for these markers at least).
Also, the table is again being included in the selection set sometimes, and since it is on a locked layer (and I'd prefer to keep it that way) it breaks the whole thing, cause the vla-move cannot move it and spits out an error (the fact that in actuality it would never really have to move it, since the moving process is based on the table basepoint and markers midpoint (which are the same exact point if the table is treated as a marker) does not matter, unfortunately).
I think I need to exclude the table from the selection in a more definite manner, but do not yet know how exactly to approach this.
As for the "drifting" problem - I do know that it has nothing to do with the coding itself, but more with the mathematics and logic behind the moving operation, but if anyone has any helpful ideas, they would be much appreciated.
So the problem turned out to be the fact that I was passing 2D points to the vla-move, while it wanted 3D ones... This part of the problem is solved then (the markers acctually move!), but if anyone has any tips on how to improve the code, feel free to share them, I know I could definitely use some.
EDIT: 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.