How to get block nearest end point or perpendicular point

[Pugazh]

Hi @dlanorh,

 These blocks are RC Rebar Range. So, copy & explode it's not possible because this is third party software.

 

14 minutes ago, dlanorh said:

 

I don't know what you are trying to do with the points you have. Perhaps an explanation would help.

 

i will send you soon one video file what i am doing  

[dlanorh]

24 minutes ago, Pugazh said:

Hi @dlanorh,

 These blocks are RC Rebar Range. So, copy & explode it's not possible because this is third party software.

 

 

i will send you soon one video file what i am doing  

 

If the blocks you sent me are the ones you are using then the routine works. The copy and explode does not affect the original block, it will always remain, the exploding is carried out on the copy. The copied block and the exploded entities are all deleted.  I think you are trying to move these to the nearest polyline is that correct. If so try this amended routine.

 

(defun rh:oppend ( obj / n_obj b_objs l_obj s_pt e_pt rtn)
  (if (= (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj)))
  (cond ( (= "AcDbBlockReference" (vlax-get obj 'objectname))
          (setq n_obj (vla-copy obj)
                b_objs (vlax-invoke n_obj 'explode)
                l_obj (car (vl-remove-if-not '(lambda (x) (= (vlax-get x 'objectname) "AcDbLine")) b_objs))
                s_pt (vlax-get l_obj 'startpoint)
                e_pt (vlax-get l_obj 'endpoint)
          )
          (vla-delete n_obj)
          (mapcar '(lambda (x) (vla-delete x)) b_objs)
          (if (equal (vlax-get obj 'insertionpoint) s_pt 0.001) (setq rtn e_pt) (setq rtn s_pt))
        )
  );end_cond
  rtn
);end_defun

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:test ( / *error* c_doc c_spc l_obj ent e_lst ss cnt obj s_pt e_pt x_obj x_pts s_d d_lst x_pt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
  );end_setq

  (while (not l_obj)
    (setq ent (car (entsel "\nSelect Line : "))
          e_lst (entget ent)
    );end_setq
    (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent)))
  );end_while


  (if (and (princ "\nSelect Bars : ")(setq ss (ssget ":L" '((0 . "INSERT")(2 . "`*U*")))))

    (repeat (setq cnt (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
            s_pt (vlax-get obj 'insertionpoint)
            e_pt (rh:oppend obj)
            x_obj (vlax-invoke c_spc 'addxline s_pt e_pt)
            x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3)
            s_d 1.0e200
            d_lst nil
      );end_setq
      (vla-delete x_obj)
      (foreach x_pt x_pts
        (if (< (setq d (distance x_pt s_pt)) s_d) (setq s_d d d_lst (list s_pt x_pt)))
        (if (< (setq d (distance x_pt e_pt)) s_d) (setq s_d d d_lst (list e_pt x_pt)))
      );end_foreach
      (vlax-invoke obj 'move (car d_lst) (cadr d_lst))
    );end_repeat
  );end_if
(princ)
);end_defun

 

This is tested on your drawing, works, but may not be exactly what you want.

 

Once loaded type TEST to run it

[Pugazh]

@dlanorh ,

 it's working fine in autocad  but our third party software if i doing copy the software are open one dialog box. how to ignore this dialog box?

 

[dlanorh]

2 hours ago, Pugazh said:

@dlanorh ,

 it's working fine in autocad  but our third party software if i doing copy the software are open one dialog box. how to ignore this dialog box?

 

 

I have this alternative that avoids copying the original, but assumes that the mid point of the block is the mid point of the line. I have changed the the routine name to BPER2

so you will need to type this instead of TEST on the command line.

 

It is tested and seems to do exactly the same as the previous one, and should be faster.

 

(defun rh:gbbc (obj / ll ur lst c_pt)
  (if (and obj (= (type obj) 'ENAME))  (setq obj (vlax-ename->vla-object obj)))
  (cond (obj
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq lst (mapcar 'vlax-safearray->list (list ll ur))
                c_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst))
          );end_setq
        )
  );end_cond
  c_pt
);end_defun

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:bper2 ( / *error* c_doc c_spc l_obj ent e_lst ss cnt obj s_pt m_pt e_pt x_obj x_pts s_d d_lst x_pt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
  );end_setq

  (while (not l_obj)
    (setq ent (car (entsel "\nSelect Line : "))
          e_lst (entget ent)
    );end_setq
    (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent)))
  );end_while


  (if (and (princ "\nSelect Bars : ")(setq ss (ssget ":L" '((0 . "INSERT")(2 . "`*U*")))))

    (repeat (setq cnt (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
            s_pt (vlax-get obj 'insertionpoint)
            m_pt (rh:gbbc obj)
            e_pt (polar s_pt (angle s_pt m_pt) (* (distance s_pt m_pt) 2.0))
            x_obj (vlax-invoke c_spc 'addxline s_pt e_pt)
            x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3)
            s_d 1.0e200
            d_lst nil
      );end_setq
      (vla-delete x_obj)
      (foreach x_pt x_pts
        (if (< (setq d (distance x_pt s_pt)) s_d) (setq s_d d d_lst (list s_pt x_pt)))
        (if (< (setq d (distance x_pt e_pt)) s_d) (setq s_d d d_lst (list e_pt x_pt)))
      );end_foreach
      (vlax-invoke obj 'move (car d_lst) (cadr d_lst))
    );end_repeat
  );end_if
(princ)
);end_defun

 

[Pugazh]

wow!!!! Great @dlanorh 

 

   It's working fine  really great thank you so much!! :).

 

I have last question, Above this code after creating xline, i want to move or offset xline (counterclockwise direction) distance is taken from dimscale.

Edited October 29, 2019 by Pugazh

[dlanorh]

3 hours ago, Pugazh said:

wow!!!! Great @dlanorh 

 

   It's working fine  really great thank you so much!! :).

 

I have last question, Above this code after creating xline, i want to move or offset xline (counterclockwise direction) distance is taken from dimscale.

 

My pleasure.

 

I think I know what you are after and why. Could you upload a small sample drawing of before and after. I did notice that some of the blocks were mirrored so accounting for this may make it slightly more difficult

Edited October 29, 2019 by dlanorh

[Pugazh]

14 minutes ago, dlanorh said:

 

My pleasure.

 

I think I know what you are after and why. Could you upload a small sample drawing of before and after. I did notice that some of the blocks were mirrored so accounting for this may make it slightly more difficult

 

Block.dwg

[dlanorh]

What do you want this new point for? What are you going to do with it? This may help me determine the logic needed to get the correct point as it is probably going to be easier to calculate this point instead of offsetting the xline and finding an intersection. Will look at this again at lunch time, work calls

[Pugazh]

5 minutes ago, dlanorh said:

What do you want this new point for? What are you going to do with it? This may help me determine the logic needed to get the correct point as it is probably going to be easier to calculate this point instead of offsetting the xline and finding an intersection. Will look at this again at lunch time, work calls

      (vlax-invoke obj 'move (car d_lst) (our new point))

[Pugazh]

7 minutes ago, dlanorh said:

What do you want this new point for? What are you going to do with it? This may help me determine the logic needed to get the correct point as it is probably going to be easier to calculate this point instead of offsetting the xline and finding an intersection. Will look at this again at lunch time, work calls

(vlax-invoke obj 'move (car d_lst) (our new point))

 

[Pugazh]

How to offset (counterclockwise direction)  

 

    (setq x_obj (vlax-invoke c_spc 'addxline s_pt e_pt))
(if (= ?)
  (progn
    (vlax-invoke x_obj 'Offset (* -1 (getvar 'DIMSCALE)))
  )
    (vlax-invoke x_obj 'Offset (* 1 (getvar 'DIMSCALE)))
)

 

[marko_ribar]

Hi, you can try to implement this routine for your problem along with your already coded solutions by @dlanorh

http://www.theswamp.org/index.php?topic=55550.msg597049#msg597049

 

It should work for blocks and dynamic blocks, but for xrefs that are complex, there are some lacks I hope someone can help to be overcome problem...

 

Regards, M.R.

 

[EDIT : I know this is hijacking topic, but if someone is willing to try to solve the problem from posted link, in attachment is my *.zip posted at theswamp...]

 

findclosestpointtonestedinblkref - problem with xrefs.zip

Edited November 8, 2019 by marko_ribar

[dlanorh]

On 05/11/2019 at 07:25, Pugazh said:

How to offset (counterclockwise direction)  

 

    (setq x_obj (vlax-invoke c_spc 'addxline s_pt e_pt))
(if (= ?)
  (progn
    (vlax-invoke x_obj 'Offset (* -1 (getvar 'DIMSCALE)))
  )
    (vlax-invoke x_obj 'Offset (* 1 (getvar 'DIMSCALE)))
)

 

 

You cannot offset counterclockwise, only left or right, and that is dependant on how the xline was constructed. Please look at the modified attached drawing as there are inconsistencies

Block(1).dwg

[Pugazh]

16 hours ago, dlanorh said:

 

You cannot offset counterclockwise, only left or right, and that is dependant on how the xline was constructed. Please look at the modified attached drawing as there are inconsistencies

Block(1).dwg 141.76 kB · 0 downloads

 

  Yeah, You are correct these all blocks are rotation 0. i have one idea, first we will set snapangle from block mid point to block insert point. 

If snapangle is 90 to 270 xline will be offset clockwise(right) direction.

If snapangle is 270 to 90 xline will be offset counterclockwise(left) direction.

Edited November 9, 2019 by Pugazh

[marko_ribar]

Just for info...

I solved findingclosestpointtofromblkref.lsp that works and for complex xrefs...

You can find my latest code on theswamp site under link I provided...

And yes I suggest using that last code as it is more reliable...

M.R.

[Pugazh]

20 hours ago, marko_ribar said:

Just for info...

I solved findingclosestpointtofromblkref.lsp that works and for complex xrefs...

You can find my latest code on theswamp site under link I provided...

And yes I suggest using that last code as it is more reliable...

M.R.

yeah i got it your code  

 

But i need this one

 

 

On 09/11/2019 at 08:57, Pugazh said:

 

  Yeah, You are correct these all blocks are rotation 0. i have one idea, first we will set snapangle from block mid point to block insert point. 

If snapangle is 90 to 270 xline will be offset clockwise(right) direction.

If snapangle is 270 to 90 xline will be offset counterclockwise(left) direction.

 

Edited November 10, 2019 by Pugazh