Lisp to move block to another arc but keep the same legth between block

[cho.steven14]

Hello All,

Is there anyway to move block from one arc to another arc but still keep the arc length between block?

Attached the desired effect

[EnM4st3r]

i would 100% do this with vlax-curve- functions. such as vlax-curve-getdistatpoint and vlax-curve-getpointatdist.

This example gets the relative distance and moves the objects according to that relative distance.

How do you plan to do the rotation?

 

(defun c:test123 (/ ent ss blks d1 p1)
  (while (not ent)
    (setq ent (car (entsel "\nSelect Curve..")))
  )
  (setq blks (LM:ss->vla (setq ss (ssget '((0 . "INSERT"))))))
  (setq d1 (vlax-curve-getdistatpoint ent (setq p1 (vlax-get (car blks) 'insertionpoint))))
  (setq blks (mapcar '(lambda (obj)
                        (cons obj (abs (- d1 (vlax-curve-getdistatpoint ent (vlax-get obj 'insertionpoint)))))
                      )
              blks
            )     
  )
  
  (setq ent nil)
  (while (not ent)
    (setq ent (car (entsel "\nSelect new Curve..")))
  )
  (command "_.move" ss "" p1 pause)
  (setq d1 (vlax-curve-getdistatpoint ent (vlax-get (caar blks) 'insertionpoint)))
  (foreach item (cdr blks)
    (vla-put-insertionpoint (car item) (vlax-3d-point (vlax-curve-getpointatdist ent (+ d1 (cdr item)))))
  )
)


;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com  
(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

[cho.steven14]

Thank you for the solution.

The solution already fix the arc length problem. But there is 2 more problem

1. Block rotation not the same with where the block located on the arc.

2. Lisp cannot move all block on different arc

[EnM4st3r]

not sure if i understnad correctly. That example should work with any arc/blocks. Or you want to move multiple blocks with multiple arcs at once??

Anyways here is another example, this time one can set a Base object at the beginning, every block is then rotated relative to the curve based on the relative rotation of the base object to the starting curve.

As an Example: if the rotation of the curve (at the point of the base object) and the base object have the same rotation (relative rotation = 0) then every Block will have the same rotation as their position at the curve.


(i feel like my desciption is kinda gibberish but im bad at describing..)

(defun c:test123 (/ ent ss blks baseObj baseDist baseAng dist)
  (while (not ent)
    (setq ent (car (entsel "\nSelect Curve..")))
  )
  (setq blks (LM:ss->vla (setq ss (ssget '((0 . "INSERT"))))))
  
  (setq baseObj (nth (getbasepos blks) blks))
  (setq baseDist (vlax-curve-getdistatpoint ent (vlax-get baseObj 'insertionpoint)))
  (setq baseAng (- (vla-get-rotation baseObj) (get-curve-angle ent baseDist)))

  (setq blks (mapcar '(lambda (obj)
                        (cons obj (- (vlax-curve-getdistatpoint ent (vlax-get obj 'insertionpoint)) baseDist))
                      )
              blks
            )     
  )
  
  (setq ent nil)
  (while (not ent)
    (setq ent (car (entsel "\nSelect new Curve..")))
  )
  (command "_.move" ss "" (vlax-get baseObj 'insertionpoint) pause)
  
  (setq baseDist (vlax-curve-getdistatpoint ent (vlax-get baseObj 'insertionpoint)))
  
  (foreach item blks
    (setq dist (+ (cdr item) baseDist))
    (vla-put-insertionpoint (car item) (vlax-3d-point (vlax-curve-getpointatdist ent dist)))
    (vla-put-rotation (car item) (+ (get-curve-angle ent dist) baseAng))
  )
)


;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com  
(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

;|
  Gets the angle at a specific distance on a curve Object
  @Param cObj \<vla-object> Curve Object
  @Param dist \<real> distance from the curve start
  @Returns \<real> angle as radiant
|;
(defun get-curve-angle (cObj dist / deriv) 
  (setq deriv (vlax-curve-getFirstDeriv cObj (vlax-curve-getParamAtDist cObj dist))) ; get vector
  (atan (cadr deriv) (car deriv)) ; Calculate the angle of the tangent vector
)


; lst = object list
(defun getbasepos (lst / circular-add l i obj bo gr g2)
  
  (defun circular-add (current add limit)
    (setq result (+ current add))
    (cond
      ((< result 0)
        (setq result (+ limit result 1))
      )
      ((> result limit)
        (setq result (- result limit 1))
      )
    )
    result
  )

  (setq l (1- (length lst)))
  (setq i 0)
  (vla-highlight (setq obj (nth i lst)) :vlax-true)
  
  (princ "\nSet Base Object [+ / -]")
  (while (not bo)
    (setq gr (grread)
          g2 (cadr gr)
    )
    (cond
        ((= g2 43);43 = [+]
          (setq i (circular-add i 1 l))
          (vla-highlight obj :vlax-false)
          (vla-highlight (setq obj (nth i lst)) :vlax-true)
          )
        ((= g2 45);45 = [-]
          (setq i (circular-add i -1 l))
          (vla-highlight obj :vlax-false)
          (vla-highlight (setq obj (nth i lst)) :vlax-true)
        )
        ((= g2 13);13 = [Enter]
         (vla-highlight obj :vlax-false)
         (setq bo t)
        )
    )
  )
  i
)

[cho.steven14]

Thank you for the solution @EnM4st3r .

This is work perfectly with one arc.

Yes, I want to move multiple blocks with multiple arcs at once. Is it possible?

Thank you for the help.

[EnM4st3r]

hmm, tbh i dont know how i would do it for multiple arcs at once.
But maybe some of my subfunctions / code snippets will still help you

[komondormrex]

meaning to copy source blocks to multiple target arcs or what?

[cho.steven14]

Hello @EnM4st3r 

I do modified the code so it doesnt need to use + or - to select baseobj.

Is it possible to filter and just move the block that is related just to the original arc?

Example if i choose many block but there is some block that is not related to the original arc so i dont need to manually deselect them.

;; Main function to move block arc length
(defun c:MBAL (/ ent ss blks baseObj baseDist baseAng dist)
  ;; Select a curve entity
  (while (not ent)
    (setq ent (car (entsel "\nSelect Start Arc : "))) ; Prompt user to select a curve
  )

  ;; Convert selected blocks to VLA objects
  (prompt "\nSelect block to move : ")
  (setq blks (LM:ss->vla (setq ss (ssget '((0 . "INSERT"))))))

  ;; Get base object and its properties
  (setq baseObj (getbasepos blks)) ; Get base object from blocks
  (setq baseDist (vlax-curve-getdistatpoint ent (vlax-get baseObj 'insertionpoint))) ; Get distance at base object
  (setq baseAng (- (vla-get-rotation baseObj) (get-curve-angle ent baseDist))) ; Calculate base angle

  ;; Adjust blocks relative to base object
  (setq blks (mapcar '(lambda (obj)
                        (cons obj (- (vlax-curve-getdistatpoint ent (vlax-get obj 'insertionpoint)) baseDist))
                      )
              blks
            )
  )

  ;; Select a new curve entity
  (setq ent nil)
  (while (not ent)
    (setq ent (car (entsel "\nSelect New Arc : "))) ; Prompt user to select a new curve
  )

  ;; Move selected blocks along the new curve
  (command "_.move" ss "" (vlax-get baseObj 'insertionpoint) pause)

  ;; Update base distance for new curve
  (setq baseDist (vlax-curve-getdistatpoint ent (vlax-get baseObj 'insertionpoint)))

  ;; Iterate over blocks and update their positions and rotations
  (foreach item blks
    (setq dist (+ (cdr item) baseDist))
    (vla-put-insertionpoint (car item) (vlax-3d-point (vlax-curve-getpointatdist ent dist)))
    (vla-put-rotation (car item) (+ (get-curve-angle ent dist) baseAng))
  )
)

;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com

;; Function to convert a selection set to a list of VLA objects
(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

;|
  Gets the angle at a specific distance on a curve Object
  @Param cObj \<vla-object> Curve Object
  @Param dist \<real> distance from the curve start
  @Returns \<real> angle as radiant
|;
(defun get-curve-angle (cObj dist / deriv) 
  (setq deriv (vlax-curve-getFirstDeriv cObj (vlax-curve-getParamAtDist cObj dist))) ; get vector
  (atan (cadr deriv) (car deriv)) ; Calculate the angle of the tangent vector
)

;; Function to SELECT base position
(defun getbasepos (lst / ent)
  ;; Prompt the user to select a base object
  (setq ent (car (entsel "\nSelect Base Block : ")))
  
  ;; Convert entity name to VLA object
  (if ent
      (vlax-ename->vla-object ent)
      ;; Return nil if no object was selected
      (progn
        (prompt "\nNo object selected or invalid selection.")
        nil
      )
  )
)

[cho.steven14]

Hello @komondormrex 

Lets say the scenario

I have 3 original arc with block, have exact arc length between block, and the block rotation are relative to where it is place on th arc.

Arc 1 = R100 with Block A, B, C with each block arc length is 5 mm

Arc 2 = R200 with Block J, K, L with each block arc length is 10 mm

Arc 3 = R300 with Block X, Y, Z with each block arc length is 15 mm

I want all the block to move to new arc but the arc length betwwen block keep the same to the original but the block rotation should be relative to where it is place in the new arc.

New Arc 1 = R120 with Block A, B, C with each block arc length is 5 mm

New Arc 2 = R230 with Block J, K, L with each block arc length is 10 mm

New Arc 3 = R340 with Block X, Y, Z with each block arc length is 15 mm

The solution that is given by @EnM4st3r is perfect for just 1 arc.

But if i choose many block and if there is block that is not related to the original arc, it will result on error.

So i need to deselect block that is not related to the arc first. But if i need to deselect hundred of them it is time consuming.

So i am thinking is it possible to slect all block and then move them to new arc but still keep the arc length and the rotation should relative to its arc.

My original MA.lsp can select all block and move them to the new arc and the rotation is relative to its arc. But the problem is the arc legth is not the same to the original.

[komondormrex]

hey there,

check this one for the starting

;***************************************************************************************************************************************************

(defun successive_sum_list (_list / sum_list)
	(setq sum_list (list (car _list)) _list (cdr _list))
	(while _list
		(setq sum_list (append sum_list (list (+ (last sum_list) (car _list))))
			  _list (cdr _list)
		)
	)
	sum_list
)

;***************************************************************************************************************************************************

(defun rotation (_angle)
	(if (zerop _angle) 0 (- (* 2 pi) _angle))
)

;***************************************************************************************************************************************************

(defun c:move_digits (/ arc_insert_list target_arc arc_object insertion_list insert_list block_start_relative_position arc_length_list
						block_copy insertion_point _prompt
					 )
	(setq _prompt "\nPick source blocks and arc in one selection..."
		  arc_insert_list (mapcar 'vlax-ename->vla-object
					   (vl-remove-if 'listp
			   				(mapcar 'cadr
								(ssnamex (ssget '((-4 . "<or")
													(-4 . "<and")
														(0 . "insert") (2 . "[12]sz")
													(-4 . "and>")
													(0 . "arc")
										  		  (-4 . "or>")
										 		 )
									 	 )
								)
							)
					)
			  )
		  target_arc (vlax-ename->vla-object (car (entsel "\nPick target arc")))
		  arc_object (car (vl-remove-if-not '(lambda (object) (= "AcDbArc" (vla-get-objectname object))) arc_insert_list))
		  insertion_list (mapcar '(lambda (insert) (vlax-get insert 'insertionpoint))
					  				(setq insert_list (vl-sort (vl-remove arc_object arc_insert_list)
					  						  	    '(lambda (insert_1 insert_2) (< (rotation (vla-get-rotation insert_1)) (rotation (vla-get-rotation insert_2))))
					  						    )
					  				)
				 		)
	      block_start_relative_position (/ (vlax-curve-getdistatpoint arc_object (car insertion_list)) (vla-get-arclength arc_object))
	      arc_length_list (mapcar '(lambda (arc) (- (vlax-curve-getdistatpoint arc_object (cadr arc)) (vlax-curve-getdistatpoint arc_object (car arc))))
				   				   (mapcar 'list insertion_list (cdr insertion_list))
			  			  )
	)
	(mapcar '(lambda (insert _distance)
				(vla-move insert (vla-get-insertionpoint insert) (vlax-3d-point (setq insertion_point (vlax-curve-getpointatdist target_arc _distance))))
				(vla-put-rotation insert (+ (* 0.5 pi) (angle insertion_point (vlax-get target_arc 'center))))
			 )
			 insert_list (successive_sum_list (cons (* block_start_relative_position (vla-get-arclength target_arc)) arc_length_list))
	)
	(princ)
)

;***************************************************************************************************************************************************

updated

[EnM4st3r]

yes, i didnt include any situations with 'wrong' blocks that are not on the arc.
But you can include that with some additional checks and filtering the blocks.

For example vlax-curve-getdistatpoint returns nil if it fails. However right now it will just supply that nil to other functions and its these other functions that fail with nil. so you could check for that beforehand and for example filter out blocks of the blks list that have a nil point with them.

[cho.steven14]

Uhmm...

Could you please add it to the code?

All my block have point on them. So is it possible to check if the block have correlateion with the arc?

Thank you for the help.

[cho.steven14]

Hello @komondormrex 

Thank you for the help.

It did move the block to differnet arc perfectly but didnt remove block on original arc.

And if I select multiple block on multiple arc together to move the lisp cannot run.

[EnM4st3r · Accepted solution]

so this one should be more presistent with 'wrong' blocks

(defun c:test123 (/ curve1 curve2 ss blks baseObj baseDist baseAng dist)
  (defun esel (str / e)
    (while (not e)
      (setq e (car (entsel str)))
    )
  )
  
  (setq curve1 (esel "\nSelect start Curve.."))
  (setq curve2 (esel "\nSelect new Curve.."))
  
  
  (setq blks (LM:ss->vla (setq ss (ssget '((0 . "INSERT"))))))
  (while (not baseDist)
    (setq baseObj (vlax-ename->vla-object (esel "\nSelect base..")))
    (setq baseDist (vlax-curve-getdistatpoint curve1 (vlax-get baseObj 'insertionpoint)))
  )
  (setq baseAng (- (vla-get-rotation baseObj) (get-curve-angle curve1 baseDist)))
  
  (setq blks (vl-remove nil
              (mapcar '(lambda (obj / dist)
                          (if (setq dist (vlax-curve-getdistatpoint curve1 (vlax-get obj 'insertionpoint)))
                            (cons obj (- dist baseDist))
                          )
                        )
                blks
              )
            )    
  )
  (command "_.move" (vlax-vla-object->ename baseObj) "" (vlax-get baseObj 'insertionpoint) pause)
  
  (setq baseDist (vlax-curve-getdistatpoint curve2 (vlax-get baseObj 'insertionpoint)))
  
  (foreach item blks
    (setq dist (+ (cdr item) baseDist))
    (vla-put-insertionpoint (car item) (vlax-3d-point (vlax-curve-getpointatdist curve2 dist)))
    (vla-put-rotation (car item) (+ (get-curve-angle curve2 dist) baseAng))
  )
)

;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com  
(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

;|
  Gets the angle at a specific distance on a curve Object
  @Param cObj \<vla-object> Curve Object
  @Param dist \<real> distance from the curve start
  @Returns \<real> angle as radiant
|;
(defun get-curve-angle (cObj dist / deriv) 
  (setq deriv (vlax-curve-getFirstDeriv cObj (vlax-curve-getParamAtDist cObj dist))) ; get vector
  (atan (cadr deriv) (car deriv)) ; Calculate the angle of the tangent vector
)

[komondormrex]

updated teh in 10 to move blocks.

regarding multiple selection, you mean you want to select multiple arcs and blocks on them for then selecting other arcs to move blocks on them. and how do know which other arc is for every set of blocks?

[cho.steven14]

Hmm...
Maybe like if i choose old arc 1, 2, 3, 4
And i choose new arc 1, 2, 3, 4
It will move all block from old arc 1 to new arc 1
So it will follow the sequence number 1 to 1, 2 to 2

[komondormrex · Accepted solution]

here you go

;***************************************************************************************************************************************************

(defun successive_sum_list (_list / sum_list)
	(setq sum_list (list (car _list)) _list (cdr _list))
	(while _list
		(setq sum_list (append sum_list (list (+ (last sum_list) (car _list))))
			  _list (cdr _list)
		)
	)
	sum_list
)

;***************************************************************************************************************************************************

(defun rotation (_angle)
	(if (zerop _angle) 0 (- (* 2 pi) _angle))
)

;***************************************************************************************************************************************************

(defun approximate_arc (arc / step_list steps approximation_length start_step)
	(setq steps (1+ (fix (/ (vla-get-totalangle arc) (/ pi 20))))
		  approximation_length (/ (vla-get-arclength arc) (float steps))
		  start_step -1
	)
	(repeat (1+ steps) (setq step_list (append step_list (list (setq start_step (1+ start_step))))))
	(mapcar '(lambda (step) (vlax-curve-getpointatdist arc step))
			 (mapcar '(lambda (step) (* step approximation_length)) step_list)
	)
)

;***************************************************************************************************************************************************

(defun c:move_inserts (/ arc_insert_list target_arc arc_object insertion_list insert_list block_start_relative_position arc_length_list
						 block_copy insertion_point _prompt
					  )
	(sssetfirst)
	(prompt "\nPick source arcs...")
	(setq arc_source_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "arc"))))))))
	(foreach source_arc arc_source_list
		(if (setq source_block_sset (ssget "_f" (approximate_arc source_arc) '((0 . "insert"))))
			(progn
				(foreach insert (vl-remove-if 'listp (mapcar 'cadr (ssnamex source_block_sset)))
					(if (< 1e-3 (distance (vlax-get (vlax-ename->vla-object insert) 'insertionpoint)
										  (vlax-curve-getclosestpointto source_arc (vlax-get (vlax-ename->vla-object insert) 'insertionpoint))
								)
						)
						(ssdel insert source_block_sset)
					)
				)
				(sssetfirst nil source_block_sset)
				(setq target_arc (vlax-ename->vla-object (car (entsel "\nPick target arc: ")))
				      insertion_list (mapcar '(lambda (insert) (vlax-get insert 'insertionpoint))
							  				  (setq insert_list (vl-sort (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex source_block_sset))))
							  							  	    		'(lambda (insert_1 insert_2) (< (rotation (vla-get-rotation insert_1)) (rotation (vla-get-rotation insert_2))))
							  							    	)
							  				  )
						 			 )
	    		  	  block_start_relative_position (/ (vlax-curve-getdistatpoint source_arc (car insertion_list)) (vla-get-arclength source_arc))
	    		  	  arc_length_list (mapcar '(lambda (arc) (- (vlax-curve-getdistatpoint source_arc (cadr arc)) (vlax-curve-getdistatpoint source_arc (car arc))))
						   				   	   (mapcar 'list insertion_list (cdr insertion_list))
					  			  	  )
				)
				(mapcar '(lambda (insert _distance)
							(vla-move insert (vla-get-insertionpoint insert) (vlax-3d-point (setq insertion_point (vlax-curve-getpointatdist target_arc _distance))))
							(vla-put-rotation insert (+ (* 0.5 pi) (angle (vlax-get target_arc 'center) insertion_point)))
						 )
						 insert_list (successive_sum_list (cons (* block_start_relative_position (vla-get-arclength target_arc)) arc_length_list))
				)
			)
		)
	)
	(sssetfirst)
	(princ)
)

;***************************************************************************************************************************************************

updated

[cho.steven14]

Hello @komondormrex 

Thank you for the help.

the multiple arc move with multiple block is already good.

But there is two problem

1. The Block Rotation is not good.

2. If there is bigger block that overlap with other arc, it will result in error. Maybe can make the checking condition is insertion point of block is on the arc instead of block on the arc?

Here the attach file condition

[cho.steven14]

Hello @EnM4st3r 

Thank you for your help for helping solving the problem to move the block on arc.

Really appreciate the help and easying the job.

[komondormrex]

are you going to get sort of a stamp designing tool?

check update in #17.