Jump to content

Add block to endpoint and align with the pline

rouho

By rouho
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

rouho Apprentice

rouho

Posted
Posted

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.

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

David Bethel Grand Master

David Bethel

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

 

:)

rouho Apprentice

rouho

Posted
  • Author
Posted

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.

David Bethel Grand Master

David Bethel

Posted
Posted

Lee,

 

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

Lee Mac Grand Master

Lee Mac

Posted
Posted
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?

rouho Apprentice

rouho

Posted
  • Author
Posted

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

Lee Mac Grand Master

Lee Mac

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

David Bethel Grand Master

David Bethel

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

rouho Apprentice

rouho

Posted
  • Author
Posted

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

David Bethel Grand Master

David Bethel

Posted
Posted

Simply redefine your block. -David

rouho Apprentice

rouho

Posted
  • Author
Posted

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

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.

×
 Share
Go to topic listing
×
×
  • Create New...