Move Block base on vertical distance
[I got confused by the use of "Polyline" in a prompt in the code, but the Arcs in the drawing and your description, but I think I see what you want.] First and essential question: will the two Arcs always (as they are in the sample drawing) be concentric, and will their ends always be in the same directions from their common center, as if one was Offset from the other [whether or not that's how they were drawn]?
Try this [minimally tested]:
(defun C:MBBA ; = Move Blocks Between Arcs
(/ A1 A2 bss n ctr disp)
(if
(and
(setq A1 (car (entsel "\nArc that Blocks are currently related to: ")))
(not (redraw A1 3)); highlight [in (not) because it returns nil]
(setq A2 (car (entsel "\nArc to Move Blocks to: ")))
); and
(progn ; then
(redraw A2 3)
(prompt "\nTo Move Blocks in their relationship between Arcs,")
(if (setq bss (ssget "_:L" '((0 . "INSERT"))))
(progn ; then
(setq
ctr (cdr (assoc 10 (setq A1data (entget A1))))
rad1 (cdr (assoc 40 A1data))
rad2 (cdr (assoc 40 (entget A2)))
disp (abs (- rad1 rad2))
); setq
(redraw); unhighlight Arcs
(repeat (setq n (sslength bss))
(setq blk (ssname bss (setq n (1- n))))
(command "_.move" blk ""
(polar
'(0 0 0)
(+
(angle ctr (cdr (assoc 10 (entget blk))))
(if (> rad1 rad2) pi 0)
); +
disp
); polar
"" ; above as displacement
); command
); repeat
); progn
); if
); progn
); if
(redraw A1 4) (redraw A2 4)
(princ)
); defun
It could check/verify various things, in addition to having the usual controls added.
@cho.steven14 wrote:
….
Is it possible that the undo process will move back all the block instead of one by one?
Because if i have hundreds of block and make some fault, i will have to press the undo hundreds time.
....
Yes -- one of the "usual controls" mentioned is Undo begin/end wrapping around the whole process. I can't add that right now, but later.... Or you can find examples elsewhere in the Forums.
@Kent1Cooper wrote:
@cho.steven14 wrote:
….
Is it possible that the undo process will move back all the block instead of one by one?
....
Yes -- one of the "usual controls" mentioned is Undo begin/end wrapping around the whole process. I can't add that right now, but later....
Try this [minimally re-tested], the red parts being added:
(defun C:MBBA ; = Move Blocks Between Arcs
(/ *error* doc A1 A2 bss n ctr disp)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc); = Undo End
(princ)
); defun - *error*
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))); = Undo Begin
(if
(and
(setq A1 (car (entsel "\nArc that Blocks are currently related to: ")))
(not (redraw A1 3)); highlight [in (not) because (redraw) returns nil]
(setq A2 (car (entsel "\nArc to Move Blocks to: ")))
); and
(progn ; then
(redraw A2 3)
(prompt "\nTo Move Blocks in their relationship between Arcs,")
(if (setq bss (ssget "_:L" '((0 . "INSERT"))))
(progn ; then
(setq
ctr (cdr (assoc 10 (setq A1data (entget A1))))
rad1 (cdr (assoc 40 A1data))
rad2 (cdr (assoc 40 (entget A2)))
disp (abs (- rad1 rad2))
); setq
(redraw); unhighlight Arcs
(repeat (setq n (sslength bss))
(setq blk (ssname bss (setq n (1- n))))
(command "_.move" blk ""
(polar
'(0 0 0)
(+
(angle ctr (cdr (assoc 10 (entget blk))))
(if (> rad1 rad2) pi 0)
); +
disp
); polar
"" ; above as displacement
); command
); repeat
); progn
); if
); progn
); if
(redraw A1 4) (redraw A2 4); un-highlight Arcs
(vla-endundomark doc)
(princ)
); defun
(vl-load-com)
But it occurs to me that with a different approach, a routine could be made to do this with any kind(s) of objects [not just Blocks], in relation to any kind(s) of path objects [not just Arcs]. It would involve many elements from MirrorAcrossObject.lsp with its MAO command, available >here<, such as getting the middle of the bounding box of each object and the point on the reference path object closest to that, but would then find the closest point on the destination path object to that point, for the Move displacement. You could use it to do exactly what MBBA does, but it would cover a much broader range of circumstances. Would that be of interest?
