Topic: BLOCK2END

[Romero]

First, an apology for the audacity to ask for your help.


The reason for my publication is to ask for help with a code that I found in the following link: https://www.theswamp.org/index.php?topic=42452.0


I am very interested in the modification; and I need to insert the blocks at the end point of lines, plines, ellipses and arcs.

I am trying to modify to simply insert a block at one end (I did) by placing it at the end point.

But what I really need is that the block is inserted at the nearest end depending on the selection of plines or bows.

Maybe someone here can help me a little, I would be totally grateful. since I'm something basic in Lisp


I attach my modified version of Lisp

Code: [Select]

;;  BlockAddEOC.lsp 
;;  Block Add to End Of Curve
;;  CAB 11.13.08  Version 1.1
;;  M.R. modified 10.08.12

(defun c:block2end (/ ss s1 bname ent ename lset doc space s sa e ea i )
  (vl-load-com)
  ;;  sub to insert the block
  (defun InsertBlock (bn pt ang lay aspace)
      (setq blk (vla-insertblock
  aspace
  (vlax-3d-point pt) ; insert point
  bn ; block name
  1.  ; scale x
  1.
  1.
  ang  ; radians
)
      )
     (vla-put-layer blk lay)
    blk
  )
  ;;; Returns object to active space (ModelSpace or PaperSpace )
  ;;  CAB 05/31/07
  (defun activespace (doc)
    (if (or (= acmodelspace (vla-get-activespace doc))
            (= :vlax-true (vla-get-mspace doc)))
        (vla-get-modelspace doc)
        (vla-get-paperspace doc)
    )
  )

  (defun getss@ (pt typs lay / ss sz vs pb swp ar wsd ppdu box)
    ;;==============================================
    ;;  CAB version
    ;; do a ssget crossing the size of the pickbox at the pick point
    (setq SZ   (getvar "SCREENSIZE") ; screen size in pixels
          VS   (getvar "VIEWSIZE") ; screen height in drawing units
          PB   (getvar "pickbox") ; get current pickbox size
          SWP  (car SZ) ; width of screen in pixels
          SHP  (cadr SZ) ; height of screen in pixels
          AR   (/ SWP SHP) ; aspect ratio width/height
          WSD  (* VS AR) ; width of screen dwg units = ratio times height
          PPDU (/ WSD SWP) ; pixels per drawing unit
          BOX  (/ (* VS (* 2 PB)) SHP) ; drawing units per pixel
    )
    (setq ss (ssget "_C"
                    (polar pt 0.785 box)
                    (polar pt 3.93 box)
                    (list (cons 0 typs) (cons 8 lay))
             )
    )
  )
 
  ;;=============================
  ;;  Start Here
  (setq CurveLay "*") ; filter for curve layer
  (setq blklay "0")  ; filter for block layer
  (prompt "\nSelect block to use or ENTER key to name block.")
  (if
    (and
      (or
       (and (setq ss (ssget "_+.:E:S" '((0 . "INSERT"))))
            (setq ent (ssname ss 0))
            (setq bname (cdr(assoc 2 (entget ent)))))
       (and (setq bname (getstring t "\nName of block to copy: "))
            (or (tblsearch "Block" bname)
                (prompt (strcat "Cannot find Block " bname ", Ending."))))
      )
      (or (prompt "\nSelect curves to test.")
          (setq lset (ssget (list '(0 . "*line,ellipse,arc")(cons 8 CurveLay))))   ;filter curve in selection set
      )
    )
      (progn
        (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
              space (activespace doc))
        (vla-EndUndoMark doc)
        (vla-StartUndoMark doc)
        (vla-zoomextents (vlax-get-acad-object))
        (setq i -1)
        (while (setq ename (ssname lset (setq i (1+ i))))
          (setq ea (angle (vlax-curve-getfirstderiv (vlax-ename->vla-object ename) (vlax-curve-getendparam (vlax-ename->vla-object ename))) '(0.0 0.0 0.0))
                 e (vlax-curve-getendpoint (vlax-ename->vla-object ename)))
                    (if (= (sslength (getss@ e "*LINE,ELLIPSE,ARC" Curvelay)) 1)
            (InsertBlock bname e ea blklay space)
          )
        )
        (vla-zoomprevious (vlax-get-acad-object))
        (vla-EndUndoMark doc)
      )
  ) ; endif

 (princ "\nThe blocks have been copied")
 (princ)               
)
(princ "\nType block2end to invoke")
(princ)


and dwg file for more details

[BIGAL]

You can in simple terms check the distance from a point to the endpoint startpoint and use that to swap if required what you need as start point. As your using a window select say centre point of window and be a little bit tighter on the window pick.

Code: [Select]

(setq d1 (distance endpt pt2))
(setq d2 (distance startpoint pt2))
    (if (> d1 d2)
    (progn
    (setq temp endpt)
    (setq endpt startpoint)
    (setq startpoint temp)
    )
    )


[Romero]

You can in simple terms check the distance from a point to the endpoint startpoint and use that to swap if required what you need as start point. As your using a window select say centre point of window and be a little bit tighter on the window pick.

Code: [Select]

(setq d1 (distance endpt pt2))
(setq d2 (distance startpoint pt2))
    (if (> d1 d2)
    (progn
    (setq temp endpt)
    (setq endpt startpoint)
    (setq startpoint temp)
    )
    )


Muchas gracias por señalarme el camino. Sin embargo, sigo intentándolo y no puedo hacerlo funcionar como deseo. Quizás puedas ayudarme un poco más. Estaría muy agradecido

[Gasty]

Hola Romero:

Una forma más robusta de asegurarte de tomar los puntos correctos es utilizar una prueba de "co0ntainment", es decir ver si los puntos extremos están al interior de la caja de selección, para eso basta comprobar si las coordenadas x,y de los puntos extremos están en el rango (xmin,xmax) para  y (ymin, ymax) para y ,que son las coordenadas extremas abajo izquierda (xmin, ymin) y arriba derecha (xmax,ymax)  de la caja de selección. Ahora, la caja de selección se puede obtener con un getcorner, y le pasas los puntos (el punto base de getcorner y el devuelto por getcorner) a un ssget crossing filtrado.

Saludos,

Gaston Nunez

[ronjonp]

Give this a try:

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ _a a b e p p1 p2 s)
2.   (defun _a (e p) (angle '(0 0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
3.   ;; RJP » 2019-08-07
4.   (cond ((null (tblobjname "block" "FL1")) (print "Block 'FL1' is not defined in this drawing!"))
5.         ((and (setq p1 (getpoint "\nPick first corner: "))
6.               (setq p2 (getcorner p1 "\nPick second corner: "))
7.               (setq s (ssget "_C" p1 p2 '((0 . "arc,line,*polyline"))))
8.          )
9.          (setq p1 (mapcar '/ (mapcar '+ p1 p2) '(2. 2. 2.)))
10.          (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
11.            (setq a (list (setq p (vlax-curve-getstartpoint x)) (_a x p)))
12.            (setq b (list (setq p (vlax-curve-getendpoint x)) (+ pi (_a x p))))
13.            (and (> (distance p1 (car a)) (distance p1 (car b))) (setq a b))
14.            (setq e (entmakex (list '(0 . "INSERT")
15.                                    '(100 . "AcDbEntity")
16.                                    '(8 . "Arrow")
17.                                    '(100 . "AcDbBlockReference")
18.                                    '(2 . "FL1")
19.                                    (cons 10 (car a))
20.                                    (cons 50 (cadr a))
21.                              )
22.                    )
23.            )
24.            (grdraw p1 (car a) 3)
25.            (redraw e 3)
26.          )
27.         )
28.   )
29.   (princ)
30. )
31.  

[GDF]

Nice one Ron...
I would add a redraw to the end

[ronjonp]

Good call Gary .. now they glow!

[Romero]

Give this a try:

Ronjonp thank you very much for the code. The truth is that it works perfectly. My sincere recognition. I'm in debt to you. You saved me hours of hard work.

[ronjonp]

Give this a try:

Ronjonp thank you very much for the code. The truth is that it works perfectly. My sincere recognition. I'm in debt to you. You saved me hours of hard work.

Glad to help. 

[Romero]

Give this a try:

Ronjonp thank you very much for the code. The truth is that it works perfectly. My sincere recognition. I'm in debt to you. You saved me hours of hard work.

Glad to help. 

Ronjon


Hi Ronjonp, I hope and I don't bother you with my comments, but abusing your trust, I want to know if you can help me with two requests regarding the code.

1.- Is it possible that the user can designate a block in the drawing? 
 (sometimes I have to use other blocks for the same purpose)

I know I can edit the code and write the name of the block. But I would have to have multiple codes for each of the blocks and I would not like that.

2.- What is the possibility that the blocks obtain the layer of the selected object?

I really appreciate the help.

[ronjonp]

Give this a try:

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ _a a b bn e l p p1 p2 s)
2.   (defun _a (e p) (angle '(0 0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
3.   ;; RJP » 2019-08-07
4.   (cond
5.     ((null
6.        (and (setq e (car (entsel "\nPick a block to use: "))) (setq bn (cdr (assoc 2 (entget e)))))
7.      )
8.      (print "Bye")
9.     )
10.     ((and (setq p1 (getpoint "\nPick first corner: "))
11.           (setq p2 (getcorner p1 "\nPick second corner: "))
12.           (setq s (ssget "_C" p1 p2 '((0 . "arc,line,*polyline"))))
13.      )
14.      (setq p1 (mapcar '/ (mapcar '+ p1 p2) '(2. 2. 2.)))
15.      (setq l (cdr (assoc 8 (entget e))))
16.      (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
17.        (setq a (list (setq p (vlax-curve-getstartpoint x)) (_a x p)))
18.        (setq b (list (setq p (vlax-curve-getendpoint x)) (+ pi (_a x p))))
19.        (and (> (distance p1 (car a)) (distance p1 (car b))) (setq a b))
20.        (setq e (entmakex (list '(0 . "INSERT")
21.                                '(100 . "AcDbEntity")
22.                                (cons 8 l)
23.                                '(100 . "AcDbBlockReference")
24.                                (cons 2 bn)
25.                                (cons 10 (car a))
26.                                (cons 50 (cadr a))
27.                          )
28.                )
29.        )
30.        (grdraw p1 (car a) 3)
31.        (redraw e 3)
32.      )
33.     )
34.   )
35.   (princ)
36. )

[Romero]

Give this a try:

Ronjon thank you very much for your help. Just what I needed, Everything is going very well now. cheers 

[ronjonp]

Give this a try:

Ronjon thank you very much for your help. Just what I needed, Everything is going very well now. cheers 

Glad to help. 🙂

[BIGAL]

Hi ronjonp was going to post something rather than using rectangle use a fence option that just drags a pline across the lines-plines etc (ssget "F" pts then compare the intersectwith point to determine start or end point. This means can do more random choice that a window would not allow. I accidently overwrote what I had should not call a lisp test.lsp.