Jump to content

Mass Move Blocks to Nearest Line


Ohnoto

Recommended Posts

I'm working on this LISP that moves selected blocks to the nearest line. I've been modifying an old LISP found at www.arch-pub.com/Move-point-perpendicular-to-line_10272335.html.

 

That LISP works, but you have to select each line individually and then each block to be moved to that line.

 

attachment.php?attachmentid=57256&cid=1&stc=1

 

The code I've currently got is below. This isn't moving the objects to the nearest line, but one that is far away from the points, and stacking all of the blocks onto the same spot.

 

;;; Modified code from: http://www.arch-pub.com/Move-point-perpendicular-to-line_10272335.html 
;;; By: Mel Franks 

(defun c:sto ( / en obj pts_ss ss_len c pten ptobj pted pt pt2)
 
 (setq en (ssget "_X" (list
            (cons 0 "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE")
            (cons 8 "A-WALL-INTR")
            ))
   )

 (princ "\nSelect Blocks: ")
 (setq pts_ss (ssget (list (cons 0 "INSERT"))))
 
(setq ss_len (sslength pts_ss))
 
(setq c 0)
 (while (< c ss_len)
   (setq pten (ssname pts_ss c))
   (setq ptobj (vlax-ename->vla-object pten))
   (setq pted (entget pten))
   (setq pt (cdr (assoc 10 pted)))

   (setq cnt 0)
   (while (< cnt (sslength en))
     (setq ename (ssname en cnt))
     (setq pt2 (vlax-curve-getClosestPointTo ename pt))
     (setq cnt (+ cnt 1))
     )
     
   (vla-move ptobj (vlax-3d-point pt) (vlax-3d-point pt2))
   (setq c (+ c 1))
   )
 
(princ)
 
)

At this point, I'm a bit confused on where to go with the code. Any assistance is appreciated.

Link to comment
Share on other sites

  • 2 years later...

Any sucess with the LISP? I've tried this code and it no worked. After select the blocks, it returns this message: error: bad argument type: lselsetp nil

Link to comment
Share on other sites

Any sucess with the LISP? I've tried this code and it no worked. After select the blocks, it returns this message: error: bad argument type: lselsetp nil

 

 

The lisp is flawed

 

 

The code I've currently got is below. This isn't moving the objects to the nearest line, but one that is far away from the points, and stacking all of the blocks onto the same spot.
Your error is cause by a nil selection set, This may be because :

 

1. you have no layer "A-WALL-INTR" in your drawing

 

2. or if it is there,you have no entities of type, ARC CIRCLE, ELLIPSE, LINE, LWPOLYLINE, POLYLINE or SPLINE on that layer

 

3. You haven't selected any blocks to move

Link to comment
Share on other sites

Looking at the code ...

 

(while (< cnt (sslength en))
 ...
)

Inside this while loop you should decide if this line is closer to the block than the previous line. What you are doing now is calculate the point (from a block) to every line/pline/arc... in your dwg, and then you just pick the last one. That's what a loop does.

Thus every block finds a point close to the last selected line and ignores every other line.

 

You need an if in there !! something like:

(if  (< (distance new_perpendicular_point pt) (distance previous_perpendicular_point pt)) (setq previous_perpendicular_point new_perpendicular_point) )

---

 

Feel free to rename the variables I added; this is just to emphasis my point

 

;;; Modified code from: http://www.arch-pub.com/Move-point-perpendicular-to-line_10272335.html 
;;; By: Mel Franks 

(defun c:sto ( / en obj pts_ss ss_len c pten ptobj pted pt pt2 this_is_the_point best_distance)
 (setq en (ssget "_X" (list
     (cons 0 "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE")
     (cons 8 "A-WALL-INTR")
   ))
 )
 (princ "\nSelect Blocks: ")
 (setq pts_ss (ssget (list (cons 0 "INSERT"))))  
 (setq ss_len (sslength pts_ss))
 (setq c 0)
 (while (< c ss_len)
   (setq pten (ssname pts_ss c))
   (setq ptobj (vlax-ename->vla-object pten))
   (setq pted (entget pten))
   (setq pt (cdr (assoc 10 pted)))

   (setq cnt 0)
   (setq best_distance 1000000)  ;; and we will search for something better.  As long as it keeps dropping we are happy
   (setq this_is_the_point nil)
   (while (< cnt (sslength en))
     (setq ename (ssname en cnt))
     (setq pt2 (vlax-curve-getClosestPointTo ename pt))
     (if (< (distance pt pt2) best_distance) (progn
       (setq best_distance (distance pt pt2))
       (setq this_is_the_point pt2)
     ))
     (setq cnt (+ cnt 1))
   )
   (vla-move ptobj (vlax-3d-point pt) (vlax-3d-point this_is_the_point))
   (setq c (+ c 1))
 )
(princ)
)

Edited by Emmanuel Delay
Link to comment
Share on other sites

Emmanuel Delay Thanks! It work very well!

 

There it is some how to make the blocks rotate perpendicular to the polyline after they move to that?

Link to comment
Share on other sites

There is a method for pline of getting the perpendicular of a point on the pline.

 

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.)
    (vlax-curve-getfirstderiv
      obj
      (vlax-curve-getparamatpoint
        obj
        pnt
      )
    )
 )
)

(setq ang    (alg-ang plobj Pt)

Link to comment
Share on other sites

... make the blocks rotate perpendicular to the polyline after they move to that?

 

Yes, add this second line:

 

   (vla-move ptobj (vlax-3d-point pt) (vlax-3d-point this_is_the_point))
   (vla-Rotate ptobj (vlax-3d-point this_is_the_point) (angle pt this_is_the_point))

 

Not sure if you want it like this. Maybe you want an extra 90° ?

And sometimes maybe 180°?

Link to comment
Share on other sites

  • 2 years later...

In the code there is pt and this_is_the_point so you can use the polar function to reset this_is_the_point at an offset just do it 1 line above the vla-move you have an angle of the two points.

 

Have a go, good to learn we are here to help if you get stuck.

Link to comment
Share on other sites

  • 2 months later...

Hello,

I am looking for a lisp that would move several selected blocks horizontally to the left or to the right so that it contacts a polyline that I would select. Ecah block would then have to move a different distance to get in contact with the polyline. The aim is like the pictures from mrigorh above, but without the rotation. Also, I'm working on autocad for mac, so I think the lisp shouldn't use Visual Lisp...

Is it possible?

Thank you,

Link to comment
Share on other sites

Because your requesting horizontal it may be possible using INTERS function which is an old lisp function and should work on the mac. For a line quick for a pline need an extra step using the vertices of the pline, needing to step through them. If have time will see what can be done unless someone else jumps in 1st.

 

Like Trudy a dwg would be best.

Link to comment
Share on other sites

On 1/6/2021 at 8:37 PM, BIGAL said:

In the code there is pt and this_is_the_point so you can use the polar function to reset this_is_the_point at an offset just do it 1 line above the vla-move you have an angle of the two points.

 

Have a go, good to learn we are here to help if you get stuck.

Hey BIGAL, thanks for your help. I get stuck in how to put this comand line of polar function as you mentioned. I need a very simple offset at a distance of 1. I'm doing it at excel, but it takes a long work.

I've tried this line but didn't work

 

    (+ (polar (this_is_the_point) (pt)) (1))
    (vla-move ptobj (vlax-3d-point pt) (vlax-3d-point this_is_the_point))
    (vla-Rotate ptobj (vlax-3d-point this_is_the_point) (angle pt this_is_the_point))

Link to comment
Share on other sites

17 hours ago, BIGAL said:

Try

(setq this_is_the _point (polar this_is_the_point (angle pt this_is _the_point ) 1))

Yes, that worked really well. Thanks!

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...