Jump to content
rouho

Add block to endpoint and align with the pline

Recommended Posts

rouho

Hello,

 

I am looking for a lisp that would add a block (ex. arrow) to the each endpoint of a pline and align it with that pline. Any ideas?

 

Thank you in advance.

Share this post


Link to post
Share on other sites
Lee Mac

I think I've coded something like this before quite recently here:

 

http://www.cadtutor.net/forum/showthread.php?52992-Auto-insert-blocks-on-pline-points-possible&p=358763&viewfull=1#post358763

 

As a quick mod to that:

 

;;-------------------=={ Block At Ends }==--------------------;;
;;                                                            ;;
;;  Inserts a Block at each endpoint of a polyline            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:BlockAtEnds ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc block ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq block "test.dwg") ;; << Block Name

 (defun *error* ( msg )
   (and doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (defun _Insert ( block point rotation )
   (entmakex
     (list
       (cons 0 "INSERT")
       (cons 2  block)
       (cons 10 point)
       (cons 50 rotation)
     )
   )
 )

 (defun _AngleatParam ( entity param )
   (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
 )       

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (cond
   ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

     (princ "\n** Current Layer Locked **")
   )
   ( (not
       (or
         (and (tblsearch "BLOCK" (vl-filename-base block))
           (setq block (vl-filename-base block))
         )
         (and
           (setq block
             (findfile
               (strcat block
                 (if (eq "" (vl-filename-extension block)) ".dwg" "")
               )
             )
           )
           (
             (lambda ( / ocm )
               (setq ocm (getvar 'CMDECHO)) (setvar 'CMDECHO 0)
               (command "_.-insert" block) (command)
               (setvar 'CMDECHO ocm)
               
               (tblsearch "BLOCK" (setq block (vl-filename-base block)))
             )
           )
         )
       )
     )

     (princ "\n** Block not Found **")
   )
   ( (not (setq ss (ssget '((0 . "*POLYLINE")))))

     (princ "\n*Cancel*")
   )
   (t

     (_StartUndo doc)
    
     (
       (lambda ( i / e )
         (while (setq e (ssname ss (setq i (1+ i))))
           (foreach param (list (vlax-curve-getStartParam e) (vlax-curve-getEndParam e))
             (_Insert block (vlax-curve-getPointatParam e param) (_AngleAtParam e param))             
           )
         )
       )
       -1
     )

     (_EndUndo doc)
   )
 )

 (princ)
)

 

Change the block name at the top of the code to suit.

Share this post


Link to post
Share on other sites
David Bethel

1) a BLOCK ARROW must exist in the dwg prior to calling

2) Align the arrow to 0 degrees

3) LWPOLYLINE Path only

 

[b][color=BLACK]([/color][/b]defun c:patha [b][color=FUCHSIA]([/color][/b]/ ss en ed pl[b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]defun massoc [b][color=NAVY]([/color][/b]key alist / x nlist[b][color=NAVY])[/color][/b]
 [b][color=NAVY]([/color][/b]foreach x alist
   [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]eq key [b][color=BLUE]([/color][/b]car x[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]setq nlist [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cdr x[b][color=RED])[/color][/b] nlist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
 [b][color=NAVY]([/color][/b]reverse nlist[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not ss[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]/= [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect a LWPOLYINE Path"[/color][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq en [b][color=NAVY]([/color][/b]ssname ss 0[b][color=NAVY])[/color][/b]
       ed [b][color=NAVY]([/color][/b]entget en[b][color=NAVY])[/color][/b]
       pl [b][color=NAVY]([/color][/b]massoc 10 ed[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=MAROON])[/color][/b][b][color=MAROON]([/color][/b]cons 2 [color=#2f4f4f]"ARROW"[/color][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 10 [b][color=GREEN]([/color][/b]append [b][color=BLUE]([/color][/b]car pl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 38 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 50 [b][color=GREEN]([/color][/b]angle [b][color=BLUE]([/color][/b]car pl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]cadr pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=MAROON])[/color][/b][b][color=MAROON]([/color][/b]cons 2 [color=#2f4f4f]"ARROW"[/color][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 10 [b][color=GREEN]([/color][/b]append [b][color=BLUE]([/color][/b]last pl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 38 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 50 [b][color=GREEN]([/color][/b]angle [b][color=BLUE]([/color][/b]last pl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]nth [b][color=RED]([/color][/b]1- [b][color=PURPLE]([/color][/b]length pl[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

Share this post


Link to post
Share on other sites
Lee Mac

Nice solution David :)

 

This may be another way to phrase the block insertion part:

 

(repeat 2
 (entmake (list (cons 0 "INSERT") (cons 2 "ARROW")
                (cons 10 (append (car pl) (list (cdr (assoc 38 ed)))))
                (cons 50 (angle (car pl) (cadr pl)))))

 (setq pl (reverse pl))
)

 

:)

Share this post


Link to post
Share on other sites
rouho

Thank you so much for your quick replies.

 

unfortunately I cannot get the BlockAtEndsto work (command : BlockAtEnds ) and patha is very close to what I am looking for but it enters the block only at the two ends of the pline. What I would like is to have that block at each endpoint within the pline.

 

Thank you once more.

Share this post


Link to post
Share on other sites
David Bethel

Lee,

 

Yep, that works as well ! Just a little more cryptic for a novice to figure out. -David

Share this post


Link to post
Share on other sites
Lee Mac
Thank you so much for your quick replies.

 

unfortunately I cannot get the BlockAtEndsto work (command : BlockAtEnds ) and patha is very close to what I am looking for but it enters the block only at the two ends of the pline. What I would like is to have that block at each endpoint within the pline.

 

Thank you once more.

 

What goes wrong?

Share this post


Link to post
Share on other sites
rouho

I have just entered the full path of the file name of the block and it worked. But again it adds the block only at the two ends of the polyline. What I would like is to add that block at each endpoint within the pline.

 

THANK YOU

Share this post


Link to post
Share on other sites
Lee Mac
What I would like is to add that block at each endpoint within the pline.

 

I'm thinking you mean the vertices... - take a look at the link I posted earlier

Share this post


Link to post
Share on other sites
David Bethel

There is a pretty big difference between endpoints and vertice points

 

This will not work well with arc segmented LWPOLYLINE paths

 

[b][color=BLACK]([/color][/b]defun c:pathav [b][color=FUCHSIA]([/color][/b]/ ss en ed pl[b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]defun massoc [b][color=NAVY]([/color][/b]key alist / x nlist[b][color=NAVY])[/color][/b]
 [b][color=NAVY]([/color][/b]foreach x alist
   [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]eq key [b][color=BLUE]([/color][/b]car x[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]setq nlist [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cdr x[b][color=RED])[/color][/b] nlist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
 [b][color=NAVY]([/color][/b]reverse nlist[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not ss[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]/= [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect a LWPOLYINE Path"[/color][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq en [b][color=NAVY]([/color][/b]ssname ss 0[b][color=NAVY])[/color][/b]
       ed [b][color=NAVY]([/color][/b]entget en[b][color=NAVY])[/color][/b]
       pl [b][color=NAVY]([/color][/b]massoc 10 ed[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]> [b][color=MAROON]([/color][/b]length pl[b][color=MAROON])[/color][/b] 1[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 2 [color=#2f4f4f]"ARROW"[/color][b][color=GREEN])[/color][/b]
                       [b][color=GREEN]([/color][/b]cons 10 [b][color=BLUE]([/color][/b]append [b][color=RED]([/color][/b]car pl[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 38 ed[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                       [b][color=GREEN]([/color][/b]cons 50 [b][color=BLUE]([/color][/b]angle [b][color=RED]([/color][/b]car pl[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cadr pl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq pl [b][color=MAROON]([/color][/b]cdr pl[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=MAROON])[/color][/b][b][color=MAROON]([/color][/b]cons 2 [color=#2f4f4f]"ARROW"[/color][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 10 [b][color=GREEN]([/color][/b]append [b][color=BLUE]([/color][/b]car pl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 38 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 50 [b][color=GREEN]([/color][/b]angle [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 10 [b][color=PURPLE]([/color][/b]entget [b][color=TEAL]([/color][/b]entlast[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]car pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

Share this post


Link to post
Share on other sites
Lee Mac

This uses the curve functions, as a modification of what is posted in that link:

 

;;-----------------=={ Block At Vertices }==------------------;;
;;                                                            ;;
;;  Inserts a Block at each vertex of selected Polylines,     ;;
;;  rotated to the angle of the segment following the vertex. ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:BlockAtVertices ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc block ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq block "test.dwg") ;; << Block Name

 (defun *error* ( msg )
   (and doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (defun _Insert ( block point rotation )
   (entmakex
     (list
       (cons 0 "INSERT")
       (cons 2  block)
       (cons 10 point)
       (cons 50 rotation)
     )
   )
 )

 (defun _AngleatParam ( entity param )
   (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
 )       

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (cond
   ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

     (princ "\n** Current Layer Locked **")
   )
   ( (not
       (or
         (and (tblsearch "BLOCK" (vl-filename-base block))
           (setq block (vl-filename-base block))
         )
         (and
           (setq block
             (findfile
               (strcat block
                 (if (eq "" (vl-filename-extension block)) ".dwg" "")
               )
             )
           )
           (
             (lambda ( / ocm )
               (setq ocm (getvar 'CMDECHO)) (setvar 'CMDECHO 0)
               (command "_.-insert" block) (command)
               (setvar 'CMDECHO ocm)
               
               (tblsearch "BLOCK" (setq block (vl-filename-base block)))
             )
           )
         )
       )
     )

     (princ "\n** Block not Found **")
   )
   ( (not (setq ss (ssget '((0 . "*POLYLINE")))))

     (princ "\n*Cancel*")
   )
   (t

     (_StartUndo doc)
    
     (
       (lambda ( i / e )
         (while (setq e (ssname ss (setq i (1+ i))))
           (
             (lambda ( param end )
               (while (<= (setq param (1+ param)) end)
                 (_Insert block (vlax-curve-getPointatParam e param) (_AngleAtParam e param))
               )
             )
             (1- (vlax-curve-getStartParam e)) (vlax-curve-getEndParam e)
           )
         )
       )
       -1
     )

     (_EndUndo doc)
   )
 )

 (princ)
)

Share this post


Link to post
Share on other sites
rouho

THANKS! This almost what I needed however I would like the block to align with the previous section of the pline. Here is a sample file. With red is what I am getting and with green what I would like to get.

 

Thank you

Share this post


Link to post
Share on other sites
David Bethel

Simply redefine your block. -David

Share this post


Link to post
Share on other sites
rouho

THANK YOU very much. This is what I have been looking !

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...