LISP move block (vertical or horizontal) to selected polyline

[zwonko]

I'm looking for LISP which will help me to move blocks to intersect selected polyline. The problem is:

-I have group of blocks in some  spacing horizontally or vertically

-I have polyline above or below, left or right from this blocks. The polyline consist of few lines in different angles or arc sometimes

-now I'm moving blocks one by one and moving it to intersect polyline

It is possible to make LISP which will do intersecition? For example I,m selecting group of blocks, after that polyline, after that say: X,Y, (maybe up,down,left,right) and now LISP is moving block to intersect polyline?

If it is possible even to do lisp which will make it only UP it will be great. I can always rotate and move polyline and group of blocks. I have hundreds of blocks to move like this...

 

I've gave attachment what I need.

 

help_me_please.dwg

[marko_ribar]

Here is for UP/DOWN, but I am sure you can figure it also for LEFT/RIGHT...

 

(defun c:moveblksup ( / c ss i b p q )

  (vl-load-com)

  (while
    (or
      (not (setq c (car (entsel "\nPick curve, placed up or down..."))))
      (if c
        (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list c)))
      )
    )
    (prompt "\nMissed or picked entity not curve...")
  )
  (while
    (or
      (prompt "\nSelect blocks you want to move up/down until intersecting with previously picked curve...")
      (not (setq ss (ssget "_:L" '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel.set...")
  )
  (repeat (setq i (sslength ss))
    (setq b (ssname ss (setq i (1- i))))
    (setq p (cdr (assoc 10 (entget b))))
    (setq q (vlax-curve-getclosestpointtoprojection c p '(0.0 1.0 0.0)))
    (if q
      (vla-move (vlax-ename->vla-object b) (vlax-3d-point p) (vlax-3d-point q))
    )
  )
  (princ)
)

 

[Ish]

u can use array command. 

[zwonko]

Thank You so much @marko_ribar! That exacly what i want to have

 

Changed it do left and right  maybe someone will need it

 

(defun c:moveblklr ( / c ss i b p q )

  (vl-load-com)

  (while
    (or
      (not (setq c (car (entsel "\nPick curve, placed left or right..."))))
      (if c
        (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list c)))
      )
    )
    (prompt "\nMissed or picked entity not curve...")
  )
  (while
    (or
      (prompt "\nSelect blocks you want to move right/left until intersecting with previously picked curve...")
      (not (setq ss (ssget "_:L" '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel.set...")
  )
  (repeat (setq i (sslength ss))
    (setq b (ssname ss (setq i (1- i))))
    (setq p (cdr (assoc 10 (entget b))))
    (setq q (vlax-curve-getclosestpointtoprojection c p '(1.0 0.0 0.0)))
    (if q
      (vla-move (vlax-ename->vla-object b) (vlax-3d-point p) (vlax-3d-point q))
    )
  )
  (princ)
)

 

4 hours ago, Ish said:

u can use array command. 

 

First of all I hate arrays. Groups are better to use for me. Second, maybe I'm don't know this option well, but propably i can't get what i want with array. Last one, it is like that i have blocks in some spacing in few views. In one they are visible as in line in second it must be "attached" to polyline, so for me is better to use group and LISP above. I'm sure that the spacing are the same.

Edited August 15, 2019 by zwonko

[BIGAL]

Maybe wrap something like this into the while then run the correct axis option could use initget.

 

 

(defun c:moveblk ( / c ss i b p q )
  (vl-load-com)
  (while
    (or
      (not (setq c (car (entsel "\nPick curve"))))
      (if c
        (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list c)))
      )
    )
    (prompt "\nMissed or picked entity not curve...")
  )
  (while
    (or
      (prompt "\nSelect blocks you want to move  intersecting with previously picked curve...")
      (not (setq ss (ssget "_:L" '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel.set...")
  )
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
;(setq ans (ah:butts but "h"  '("Choose" "U-D" "L-R" )))
(setq ans (ah:butts but "v"  '("Choose" "U-D" "L-R" )))
  (repeat (setq i (sslength ss))
    (setq b (ssname ss (setq i (1- i))))
    (setq p (cdr (assoc 10 (entget b))))
    (cond
    ( (= ans "L-R") (setq q (vlax-curve-getclosestpointtoprojection c p '(1.0 0.0 0.0))))
    ( (= ans "U-D") (setq q (vlax-curve-getclosestpointtoprojection c p '(0.0 1.0 0.0))))
    )
     (if q
      (vla-move (vlax-ename->vla-object b) (vlax-3d-point p) (vlax-3d-point q))
    )
  )
  (princ)
)

(c:moveblk)

 

 

Multi radio buttons.lsp

Edited August 17, 2019 by BIGAL

[zwonko]

That one is very nice  like I wan't it to be

thanks @BIGAL

[BIGAL]

Thanks to Marko for the initial code I just tweaked it a bit.

[Keyhylyn]

Hello,

I am looking for exactly this .lisp, but since I'm working on autocad for mac I have this error "vl-load-com is not supported on  "Mac OS X Version 10.15 (x86_64)"".

Could it be possible to have this lisp written but without Lisual LISP so that it works on mac??

Pleeaaase  thank you

 

 

[BIGAL]

See your other post answered there,  ask Admin to move your other posts to say here so continues on theme.

 

This is a test so make a line and a block need to know all the rules like offsets etc need that dwg. 

 

(defun c:test ( / ent ent2 pt1 pt2 pt4 pt4)
(setq ent (entsel "\npick block"))
(setq pt1 (cdr (assoc 10 (entget (car ent)))))
(setq pt2 (polar pt1 0.0 20))
(setq ent2 (entsel "\npick line"))
(setq pt3 (cdr (assoc 10 (entget (car ent2)))))
(setq pt4 (cdr (assoc 11 (entget (car ent2)))))
(setq pt2 (inters pt1 pt2 pt3 pt4 nil))
(command "move" ent "" pt1 pt2)
)
(c:test)

 

Edited March 16, 2021 by BIGAL

[Ajmal]

(defun c:alb(/ ss i *error* basept obj_len)
  (defun *error* ( msg )
        (foreach lay lck (vla-put-lock lay :vlax-true))
        (if (= 'int (type cmd)) (setvar 'cmdecho cmd))
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
  (defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)
(while
  (if
    (setq i 0 ss (LM:ssget "\nSelect block <exit>: " '("_:L"((0 . "INSERT"))))
	  obj_len(sslength ss))
    (progn
      (if(null global:ans:alb)
	(setq global:ans:alb "Vertical")
	)
      (initget "Vertical Horizontal")
      (if (setq tmp (getkword (strcat "\nChoose [Vertical/Horizontal] <" global:ans:alb ">: ")))
	(setq global:ans:alb tmp)
	)
      )
    )
  (setq basept(getpoint "\nEnter Alignment Point: "))
  (repeat obj_len
    (setq obj_pt(cdr (assoc 10 (entget (ssname ss i)))))
    (if (= global:ans:alb "Vertical")
      (progn(setq new_pt(list(car basept)(cadr obj_pt))))
      (progn(setq new_pt(list(car obj_pt)(cadr basept))))
      )
    (command "move" (ssname ss i) "" obj_pt new_pt)
    (setq i (1+ i))
    )
    )
  )

 

[BIGAL]

Ajmal wants code for mac so no VL code. VL is not supported on a MAC.

[Rorororomeo]

Thank you so much @BIGAL