Lisp routine to draw a line with arrow heads on both ends of the line

[Anonymous]

Does anyone have a lisp routine that will allow you to pick  2 points and then will draw a line between those 2 points and place arrow heads at both ends of the line?

It would be nice to be able to list the line that is drawn and get a distance that is from the 2 points that were selected and not shortened by the arrow heads, but is the actual distance between the 2 points selected.

I've seen some lisps that draw double leader lines to accomplish this but that is not a good solution, because you can not list the line and get an actual distance.

Just want to select a point then another point and have the program draw a simple line between the 2 points and add arrow heads to the ends.

I know all this can be done with autocad dimensioning, but I'm looking for a simple way to accomplish this without dealing with all the dimensioning variables and annotative situations, just plain and simple way to dimension drawings.

Anyone have a routine like this.

[Ajilal.Vijayan]

Hi,

Try this simple lisp with the attached drawing.

It will ask you to pick two points and place an aligned dimension between those points.

As you said, you dont want dimension, the program will explode the dimension to result in line and arrows at the end.

Also make sure, the dimension style supress the extension lines ( or use the dimension style from the attached drawing.)

Spoiler

(defun C:DF ()
(setq P1 (getpoint "\nPick the first point:"))
(setq P2 (getpoint "\nPick the second point:"))

(command "dim" "al" P1 P2 P2 "" "exit");draw dimension
(command "explode" "L");explode
);defun

[Anonymous]

zootango,

Is this what you are looking for:

(vl-load-com)

(defun c:arowline (/ p1 p2 len block-scale txtheight txtins ) 

 (if (not (tblsearch "BLOCK" "ARROW")) (make_block))
 
 (setq p1 (getpoint "\nFirst Point:")
 p2 (getpoint "\nSecond Point:")
 ) 
 (entmakex (list (cons 0 "LINE")
 (cons 10 p1)
 (cons 11 p2)))

 (setq len (distance p1 p2)
 )
 (setq block-scale (/ len 3))
 
 (Insertblock "ARROW" p1 block-scale block-scale (angle p1 p2))
 (Insertblock "ARROW" p2 block-scale block-scale (angle p2 p1))

 (setq txtheight (/ len 30)
 txtins (polar (polar p1 (angle p1 p2) (/ len 2)) (+ (/ pi 2)(angle p1 p2)) (* txtheight 0.3))
 )
 (text2 txtins txtheight (rtos len 2 2) (angle p1 p2))
 )

(defun InsertBlock (Name InsPt XScale YScale Rot) 
 
 (vla-insertblock
 ((if (eq (getvar "cvport") 1)
 vla-get-paperspace
 vla-get-modelspace
 ) ;_ if
 (vla-get-ActiveDocument
 (vlax-get-acad-object)
 ) ;_ vla-get-ActiveDocument
 )
 (vlax-3d-point InsPt)
 Name
 XScale
 YScale
 XScale
 Rot
 ) ;_ vla-insert-block
)
(defun make_block ()
 
 (entmake ;BLOCK Header definition:
 '((0 . "BLOCK") (2 . "ARROW") (70 . 2) (10 0.0 0.0 0.0))) 
 (lwpoly1 '((0. 0. 0.) (0.18 0.03 0.) (0.18 -0.03 0.)) 1);LWPOLYLINE definition:
 (entmake '((0 . "ENDBLK")));BLOCK's ending definition:
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;polyline

(defun LWPoly1 (lst cls)
 (entmake (append (list (cons 0 "LWPOLYLINE")
 (cons 100 "AcDbEntity")
 (cons 100 "AcDbPolyline")
 (cons 90 (length lst))
 (cons 70 cls)
 
 ) 
 (mapcar (function (lambda (p) (cons 10 p))) lst)))
 )

(defun Text2 (pt hgt str ang)
 (entmakex (list (cons 0 "TEXT")
 (cons 10 pt)
 (cons 40 hgt)
 (cons 1 str)
 (cons 50 ang)
 ))
 )

If this is what you need, we might put text alignment to centar, and some hatch on arrows.

Hope this help.

dicra

[Anonymous]

Thanks Ajilal, this lisp uses the autocad dimensioning for aligned dimensions and explodes it.

I'm looking for something that just uses lisp to draw a line from point to point and then the tricky part of inserting ( I guess) an arrowhead block on each end of the line, then as a bonus the lisp could extract the distance of the line, locate the mid point of the line, start the dtext command using the current text style and height, and place the distance text (in feet ') above the line at the mid point of the line.

I think the hard part is the arrowhead block, or maybe could somehow use the dimensioning arrowhead so that the arrowhead size could be controlled with the DIMASZ variable.

Then there is the issue of using the lisp in paper space or model space ( as far as extracting and labeling the line length).

Some of our cad people here are not that experienced with Autocad dimensioning are becoming overwhelmed with all the variables.

How dimensioning is being done presently by some is: draw a line, insert an arrowhead block on each end of the line, list the length of the line, use the dtext or mtext command and place and align the text above the line.  A lot of steps just to dimension something.

So I was looking for a lisp that would automate those steps that would still be similiar to what they are currently doing without involving Autocad's dimensioning functions.

Silly I know, but in our case I can see where a lisp like this would be a help to our users.

[Anonymous]

Thanks dicra,

Your lisp is kinda there, it seems that whatever layer is current when the lisp is loaded the first time is the layer that is always used to create the objects even if you reload the lisp with a different layer current.

Would like the arrowheads solid ( what controls the arrowhead size?)

Would like all objects to be on the current layer.

Would like the text to be of the current text style and height and have a foot mark (253.45')

Other than these items your lisp is there though.

[Kent1Cooper]

I would highly recommend using a Dimension anyway.  It will be one object for purposes of selection when you want to Erase it, its arrowheads will adjust direction if you have reason to Stretch or grip-drag one or another point, and you can still see the length in its Properties as you can for a Line, under Measurement [though admittedly LIST does not seem to report that].  If you give it a space for override text content, it will end up with just the dimension line and arrowheads.  A variant on Ajilal.Vijayan's suggestion [minimally tested]:

(defun C:DNTE (/ pt1 pt2); = Dimension No Text or Extension

  (setq

    pt1 (getpoint "\nFirst point: ")

    pt2 (getpoint "\nSecond point: ")

  ); setq

  (command "_dimaligned" "_none" pt1 "_none" pt2 "_text" " " "_none" pt2)

); defun

Define a particular Dimension Style if you want one for this that's different from your usual Dimensioning, and include setting that to be current in the routine, and possibly saving what's current first and then setting that back at the end.

[EDIT:  This was in response to the first post only, not the later one about "simulating" a Dimension, which I would discourage you from doing in the strongest terms.  Wouldn't it be easier to establish a Dimension Style that handles all the variables users are afraid of, have it in all drawing templates so they don't need to know the gory details, and do a very small amount of training so people know how to use Dimensions, rather than use a fake-it approach?  If you simulate Dimensions with Lines and Blocks and Text, the first time someone Stretches something and isn't aware enough to fix the fake Dimension text, and a drawing goes out un-corrected, you'll regret it.  When I first started using AutoCAD in 1984 (Version 1.4), Dimensions were all like that, and it was a huge relief when they became intelligent objects -- the benefits are multitudinous, and well worth the small effort it would take to show people even just the basics of how to use them, even if only the linear varieties it sounds like you're talking about.]

[Anonymous]

Zootango, 

If you are having reason not to accept dimensions, I changed the routine based on your request.

If you are accepting dimensions as solution, I hope that it is going to help someone else, at least for educational purpose.

@Anonymous wrote:

Thanks dicra,

Your lisp is kinda there, it seems that whatever layer is current when the lisp is loaded the first time is the layer that is always used to create the objects even if you reload the lisp with a different layer current.

Would like the arrowheads solid ( what controls the arrowhead size?)

Would like all objects to be on the current layer.

Would like the text to be of the current text style and height and have a foot mark (253.45')

Other than these items your lisp is there though.

---

-It is making everything in current layer, block, text and arrows are in current layer, but objects which are in block definition are now stored in layer "0".

 If block if defined, you will have to purge block, so that it will be recreated.

-Arrows are now solid, arrow size is based on length of line:

(setq block-scale (/ len 3));arrow scale - you can change this line to real value, if you wan't it to be constant (setq block-scale 1.0), or you can change it to (if (not block-scale) (setq block-scale (getreal "\nArrow size:")))

and remove block scale from local variables.

-Object is on current layer

-You have now foot mark on text, and if you want to put some another text style, you can do that in scs:addtext function, by adding line:

(vla-put-stylename thetext "Your_style_name")

Here is the changed code:

(vl-load-com)

(defun c:arrowline (/ p1 p2 len block-scale txtheight txtins ) 

 (if (not (tblsearch "BLOCK" "ARROW")) (make_block))
 
 (setq p1 (getpoint "\nFirst Point:")
       p2 (getpoint "\nSecond Point:")
 ) 
 (entmakex (list (cons 0 "LINE")
 (cons 10 p1)
 (cons 11 p2)))

 (setq len (distance p1 p2)
 )
 (setq block-scale (/ len 3));arrow scale 
 
 (Insertblock "ARROW" p1 block-scale block-scale (angle p1 p2))
 (Insertblock "ARROW" p2 block-scale block-scale (angle p2 p1))

 (setq txtheight (/ len 30));text height 
 (setq txtins (polar (polar p1 (angle p1 p2) (/ len 2)) (+ (/ pi 2)(angle p1 p2)) (* txtheight 0.3)))
 (scs:addtext txtins txtheight (strcat (rtos len 2 2) "'") (angle p1 p2))
 );end defun

(defun InsertBlock (Name InsPt XScale YScale Rot) 
 
 (vla-insertblock
 ((if (eq (getvar "cvport") 1)
 vla-get-paperspace
 vla-get-modelspace
 ) ;_ if
 (vla-get-ActiveDocument
 (vlax-get-acad-object)
 ) ;_ vla-get-ActiveDocument
 )
 (vlax-3d-point InsPt)
 Name
 XScale
 YScale
 XScale
 Rot
 ) ;_ vla-insert-block
)

;Block definition
(defun make_block ()
					;BLOCK Header definition:
  (entmake'((0 . "BLOCK") (2 . "ARROW") (70 . 2) (10 0.0 0.0 0.0)))
					;LWPOLYLINE definition:
  (lwpoly1 '((0. 0. 0.) (0.18 0.03 0.) (0.18 -0.03 0.)) 1)
  					;HATCH definition:
  (make_hatch '(0. 0. 0.)'(0.18 0.03 0.)'(0.18 -0.03 0.))
					;BLOCK's ending definition:
  (entmake '((0 . "ENDBLK")))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;polyline

(defun LWPoly1 (lst cls)
  (entmake (append (list (cons 0 "LWPOLYLINE")
			 (cons 100 "AcDbEntity")
			 (cons 100 "AcDbPolyline")
			 (cons 8 "0")
			 (cons 90 (length lst))
			 (cons 70 cls)			 
			 )		   
                    (mapcar (function (lambda (p) (cons 10 p))) lst)))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;HATCH
(defun make_hatch (p1 p2 p3 /)
  (entmake
    (list (cons 0 "HATCH")
	  '(100 . "AcDbEntity")
	  (cons 8 "0")
	  '(100 . "AcDbHatch")
	  (cons 62 256)
	  (cons 10 (list 0.0 0.0 0.0))
	  (cons 210 (list 0.0 0.0 1.0))
	  ;;changed z
	  (cons 2 "SOLID")
	  (cons 70 1)(cons 71 0)(cons 91 1)(cons 92 1)(cons 93 3)
	  (cons 72 1)(cons 10 p1)(cons 11 p2)
	  (cons 72 1)(cons 10 p2)(cons 11 p3)
	  (cons 72 1)(cons 10 p3)(cons 11 p1)
	  (cons 97 0)(cons 75 2)(cons 76 1)
	  (cons 98 1)
	  (cons 10 (list 0.0 0.0 0.0))
	  (cons 470 "LINEAR")
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;TEXT
(defun scs:addText (apt ht thestring rotation / mspace thetext)
  (vl-load-com)
  (setq	mspace (vla-get-modelspace
		 (vla-get-activedocument
		   (vlax-get-acad-object)
		 )
	       )
  )
  (setq	thetext	(vla-AddText
		  mspace
		  thestring
		  (vlax-3d-point apt)
		  ht
		)
  )
  (vla-put-rotation thetext rotation)
  (vla-put-Alignment thetext acAlignmentBottomCenter)
  (vla-put-TextAlignmentPoint thetext (vlax-3d-point apt))
  (princ)
)					;defun

 PS Note that I changed function name to "arrowline"

I hope it helps!

dicra

[smaher12]

(defun c:test (/ P1 P2 AL1 AL2 AW)
 (setvar 'cmdecho 0)

 (setq P1 (getpoint "\nSpecify start point: ")
       P2 (getpoint P1 "\nSpecify end point: ")
       AL1 (polar P1 (angle P1 P2) (/ (getvar 'dimscale) 8)) ; arrowhead length
       AL2 (polar P2 (angle P1 P2) (-(/ (getvar 'dimscale) 8))) ; arrowhead length
       AW (/ (getvar 'dimscale) 24) ; arrowhead width
 )
 (command "_.pline" "_none" P1 "W" "0" AW "_none" AL1 "W" "0" "0" 
                    "_none" AL2 "W" AW "0" "_none" P2 "")
 (princ)
)

[Kent1Cooper]

---

@smaher12 wrote:

(defun c:test (/ P1 P2 AL1 AL2 AW)
 (setvar 'cmdecho 0)
 (setq P1 (getpoint "\nSpecify start point: ")
       P2 (getpoint P1 "\nSpecify end point: ")
       AL1 (polar P1 (angle P1 P2) (/ (getvar 'dimscale) 8)) ; arrowhead length
       AL2 (polar P2 (angle P1 P2) (-(/ (getvar 'dimscale) 8))) ; arrowhead length
       AW (/ (getvar 'dimscale) 24) ; arrowhead width
 )
 (command "_.pline" "_none" P1 "W" "0" AW "_none" AL1 "W" "0" "0" 
                    "_none" AL2 "W" AW "0" "_none" P2 "")
 (princ)
)

---

The sizes of things depends on what your Dimension arrowhead size setting is.  The above is written for an arrowhead length of 1/8 unit, but AutoCAD's default [in the version I have here] is 0.18, and people will have different standards.  If the idea is to duplicate the appearance of AutoCAD's default closed-filled arrowheads, but in keeping with current size settings, then something like this would be more appropriate:

(defun c:test2 (/ P1 P2 AL AL1 AL2 AW)
  (setvar 'cmdecho 0)
  (setq

    P1 (getpoint "\nSpecify start point: ")
    P2 (getpoint P1 "\nSpecify end point: ")
    AL (* (getvar 'dimscale) (getvar 'dimasz)) ; arrowhead length

    AL1 (polar P1 (angle P1 P2) AL) ; arrowhead end from start
    AL2 (polar P2 (angle P2 P1) AL) ; arrowhead end from finish
    AW (/ AL 3) ; arrowhead width
  )
  (command "_.pline" "_none" P1 "W" "0" AW "_none" AL1 "W" "0" "0"
                    "_none" AL2 "W" AW "0" "_none" P2 "")

  (setvar 'cmdecho 1) ; don't forget this [or save whatever it's set to first, then reset here]
  (princ)
)

If the current arrowhead is something other than AutoCAD's closed-filled [whether another AutoCAD option or a User-custom Block], something could be done to Insert whatever Block it is at each end of a Line, using (* (getvar 'dimscale) (getvar 'dimasz)) used as the scale factor.  It would be complicated by the possibility that the current settings could be for different arrowheads at the two ends, but all that could be accounted for.

[Kent1Cooper]

@Anonymous wrote:

.... 

....
;Block definition
(defun make_block ()
					;BLOCK Header definition:
  (entmake'((0 . "BLOCK") (2 . "ARROW") (70 . 2) (10 0.0 0.0 0.0)))
					;LWPOLYLINE definition:
  (lwpoly1 '((0. 0. 0.) (0.18 0.03 0.) (0.18 -0.03 0.)) 1)
  					;HATCH definition:
  (make_hatch '(0. 0. 0.)'(0.18 0.03 0.)'(0.18 -0.03 0.))
					;BLOCK's ending definition:
....

.... 

---

If duplicating AutoCAD's closed-filled arrowhead is the approach, and the possibility of other arrowheads is not to be accounted for:

Instead of drawing a Polyline [not needed, actually] and filling it with a solid Hatch pattern [which will do by itself], just make a much simpler 2D Solid.  That's what AutoCAD does for closed-filled arrowheads [draw a Dimension using them, Explode it, and you'll see].

Also consider whether a Dimension arrowhead size setting other than AutoCAD's default should determine the size, rather than having it fixed as above.

[Anonymous]

Kent,

I agree with you.

Thank you for spending time to recheck my code.

dicra

[Kent1Cooper]

---

@Anonymous wrote:

Does anyone have a lisp routine that will allow you to pick  2 points and then will draw a line between those 2 points and place arrow heads at both ends of the line?

....

---

It's not "supposed" to be possible with a linetype definition, but check out the drawing attached  >>here<<,  and the discussion in several Posts following it.  I don't know how it's done, and unless someone can reverse-engineer the definitions it's probably not possible to substitute different arrowheads than are in those linetypes, but you can copy those out and paste them into your drawings, and have the use of them.