Lisp to move objects along z axis

[saycaphe]

Hey guys!

I need a List, to be that makes moving selected objects along the z-axis, with increment intervals from base point.

Distance from each line is 500.

That mean the nearest line with base point will be moved 500, the next one will be moved 1000(2x500) and the next will 1500(3x500).

Sorry for my english

[Tharwat]

Hi,

 

Try this UNTESTED program and let me know how you get on with it.

 

(defun c:Test ( / int inc run org sel ent lst)
 ;;------------------------------------;;
 ;;	Tharwat - Date: 31.Jul.2017	;;
 ;; Move selected objects on Z axis	;;
 ;; with intervals of 500 units.	;;
 ;;------------------------------------;;
 (if (setq int -1 inc 500. run 0. org '(0. 0. 0.) sel (ssget "_:L" '((0 . "~VIEWPORT"))))
   (progn
     (while (setq ent (ssname sel (setq int (1+ int))))
       (setq lst (cons (list (distance org (vlax-curve-getclosestpointto ent org)) ent) lst))
       )
     (foreach obj (vl-sort lst '(lambda (j k) (< (car j) (car k))))
       (vlax-invoke (vlax-ename->vla-object (cadr obj)) 'move org (list 0. 0. (setq run (+ inc run))))
       )
     )
   )
 (princ)
 ) (vl-load-com)

[saycaphe]

Tharwat, thanks for your help.

Only have a small question: How can we have a sequence to move the Frames on Plane x0z along y axis, with increment intervals from z axis.

May we cut Frames by a line, parallel with 0x, and the distance from cutting points ( from small to large) will be sequence to move

Frames.dwg

[saycaphe]

And how move Frames on Plane x0y along z axis, Frames on Plane y0z along x axis.

Thanks

[Tharwat]

Tharwat, thanks for your help.

You're welcome.

 

Only have a small question: How can we have a sequence to move the Frames on Plane x0z along y axis, with increment intervals from z axis.

May we cut Frames by a line, parallel with 0x, and the distance from cutting points ( from small to large) will be sequence to move

 

You can play with the Axes in the following codes to move object on any Axis you want.

(list 0.[color="red"] ;; X Axis[/color]
     0. [color="green"];; Y Axis[/color]
    (setq run (+ inc run)) [color="blue"];; Z Axis[/color]
)

[saycaphe]

With Red polylines, moving is ok.

With Blue polylines, moving is not in sequence .

When i change all color is Red, there polylines also not follow the sequence .

How can we change:o

[Tharwat]

The codes that I highlighted with colours in my previous reply have nothing to do with objects in the same colours inside that drawing, but they are X,Y,Z coordinates.

[saycaphe]

Hi Tharwat.

Red and blue, i mean the colour of the polylines, not about the colour that you highlighted.

Only the sequence to move, the lisp move the red polylines first, and then blue ones

[Roy_043]

The problem is not as simple as the OP suggests. Some sections consist of two polylines. So sorting them by their distance from a single point will not work.

[Roy_043]

Another issue:

The blue polylines (actually color 152) are drawn on top of red polylines.

In the attached drawing that issue has been fixed and a magenta line has been added.

 

With that line as input the code below gives a reasonable result. But the sections belonging to the bulbous protrusion still have to be moved manually.

 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)

(defun c:Test ( / cur enm inc obj ss sta)
 (setq inc 500.0)
 (setq cur 0.0)
 (setq enm (car (entsel "\nSelect magenta line: ")))
 (setq obj (vlax-ename->vla-object enm))
 (setq ss
   (ssget
     "_F"
     (list
       (trans (setq sta (vlax-get obj 'startpoint)) 0 1)
       (trans (vlax-get obj 'endpoint) 0 1)
     )
     '((0 . "LWPOLYLINE") (-4 . "<OR") (62 . 1) (62 . 152) (-4 . "OR>"))
   )
 )
 (foreach pl
   (mapcar
     'cadr
     (vl-sort
       (mapcar
         '(lambda (pl) (list (distance sta (vlax-invoke obj 'intersectwith pl acextendnone)) pl))
         (KGA_Conv_Pickset_To_ObjectList ss)
       )
       '(lambda (a b) (< (car a) (car b)))
     )
   )
   (vlax-invoke pl 'move '(0.0 0.0 0.0) (list 0.0 (setq cur (+ cur inc)) 0.0))
 )
 (princ)
)

Frames_2.dwg

[saycaphe]

Hi Roy_04.

Have error when i selected the magenta line.

 

"Select magenta line: ; error: bad argument type: 2D/3D point: (-1388.12 3.70499e-013 1668.58 -791.629 5.12511e-013 2308.15)

 

How to solve this problem?

 

Thanks!

Kind Regards!

[Roy_043]

The line may only have a single intersection with each polyline.

Please check if the code works for the Frames_2.dwg and post your new dwg.

[saycaphe]

The line may only have a single intersection with each polyline.

Please check if the code works for the Frames_2.dwg and post your new dwg.

Code with Frames_2 is working. But when i try to work with the same situaltion, it's no worked.

I try to keep the Frames on x0y, and move along axis 0z, after that will rotate.

but also have error.

 

can you take alook to this drawing

 

Thanks!

Kind Regards!

Drawing3.dwg

[Roy_043]

Your drawings are not consistent when it comes to the 3D alignment of the sections. But the new code will handle both your first and your last drawing.

 

In your last drawing there are two sections that are closed polylines. You have to pick the points of the temporary line more carefully to avoid intersecting them twice.

 

New code below.

The code will draw (and erase) the temporary line.

Only the red polylines are moved.

 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)

(defun c:Test ( / cur doc end errCnt inc lnObj ss sta vec)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq sta (getpoint "\nStart point of temporary line (line may intersect every polyline only once!): "))
     (setq end (getpoint sta "\nEnd point of temporary line: "))
     (setq ss (ssget "_F" (list sta end) '((0 . "LWPOLYLINE") (62 . 1))))
     (setq inc (getreal "\nDistance between sections: "))
   )
   (progn
     (setq ss (KGA_Conv_Pickset_To_ObjectList ss))
     (setq errCnt 0)
     (setq vec (trans (list 0.0 0.0 (- inc)) 0 (vlax-get (car ss) 'normal))) ; Use the normal of the first object in ss.
     (setq cur '(0.0 0.0 0.0))
     (setq lnObj (vlax-invoke (vla-get-modelspace doc) 'addline (setq sta (trans sta 1 0)) (trans end 1 0)))
     (foreach
       plObj
       (mapcar
         'cadr
         (vl-sort
           (vl-remove
             nil
             (mapcar
               '(lambda (plObj / coordLst)
                 (setq coordLst (vlax-invoke lnObj 'intersectwith plObj acextendnone))
                 (if (= 3 (length coordLst))
                   (list (distance sta coordLst) plObj)
                   (progn
                     (setq errCnt (1+ errCnt))
                     nil
                   )
                 )
               )
               ss
             )
           )
           '(lambda (a b) (< (car a) (car b)))
         )
       )
       (vlax-invoke plObj 'move '(0.0 0.0 0.0) (setq cur (mapcar '+ cur vec)))
     )
     (vla-delete lnObj)
     (if (/= 0 errCnt)
       (princ (strcat "\nError: skipped " (itoa errCnt) " polyline(s) that were intersected more than once "))
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)