Jump to content
MS13

Arrow (lisp modification)

Recommended Posts

MS13

Hello again.

 

I am using routine 

Quote

(defun c:ahl (/ p1 p2 p3 p4 a10 a1 a2 s1 s2 lin pickpt linname lindata ang1)
  (setq cosmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq    lin    (entsel "\nPick a line: ")
    pickpt    (cadr lin)
    linname    (car lin)
    lindata    (entget linname)
    p1    (cdr (assoc 10 lindata))
    p2    (cdr (assoc 11 lindata))
  )
  (if (< (distance p1 pickpt) (distance pickpt p2))
    (setq p3 p1
      p1 p2
      p2 p3
    )
  )
  (setq    ang  (angle p1 p2)
    ang1 (* (/ ang pi) 180)
    a10  (* (/ 10.0 180) pi)
    a1   (+ (- ang a10) pi)
    a2   (+ (+ ang a10) pi)
  )
  (if (= (getvar "USERR1") 0.0)
    (setvar "USERR1" 3.0)
  )
  (setq s1 (getvar "USERR1"))
  (setq mess (strcat "\nArrow Size = <" (rtos s1) "> "))
  (setq s2 (getreal mess))
  (if (= s2 nil)
    (setq s2 s1)
    (setvar "USERR1" S2)
  )
  (setq    p3 (polar p2 a1 s2)
    p4 (polar p2 a2 s2)
  )
  (command "SOLID" p2 p3 p4 p3 "")
  (setvar "OSMODE" cosmode)
)
 

 

Is there a chance to modify it and: 

1) Insert arrow where I want on the line (snap)

2) Or at least add option to change which end of the line should have arrow. Sometimes it picks up wrong end (not the one I want) and I need to rotate for 180 deg and elevate arrow

 

Thanks

Share this post


Link to post
Share on other sites
ronjonp

Any reason you don't just use a leader?

  • Like 1

Share this post


Link to post
Share on other sites
MS13

Because I need to arrow some lines in the drawing 

Share this post


Link to post
Share on other sites
BIGAL

The correct end can be checked by comparing pick point to end points distance and swap start end point if required, on iPad will post code later

Share this post


Link to post
Share on other sites
ronjonp
6 minutes ago, BIGAL said:

The correct end can be checked by comparing pick point to end points distance and swap start end point if required, on iPad will post code later

The code already does that.

Share this post


Link to post
Share on other sites
BIGAL

Hi ronjonp did not look to close in that case sounds like operator error.

Share this post


Link to post
Share on other sites
ronjonp
On 2/2/2019 at 3:22 PM, BIGAL said:

Hi ronjonp did not look to close in that case sounds like operator error.

Yeah .. I'm not sure what's going on. Maybe the OP can post a drawing where it does not work.

Share this post


Link to post
Share on other sites
ronjonp

Maybe this will help:

(defun c:foo (/ a e p0 p1 p2)
  (cond	((null (tblobjname "block" "_ar"))
	 (entmake '((0 . "BLOCK")
		    (100 . "AcDbEntity")
		    (67 . 0)
		    (8 . "0")
		    (100 . "AcDbBlockReference")
		    (2 . "_ar")
		    (10 0 0 0)
		    (70 . 0)
		   )
	 )
	 (entmake '((0 . "LWPOLYLINE")
		    (100 . "AcDbEntity")
		    (67 . 0)
		    (8 . "0")
		    (100 . "AcDbPolyline")
		    (90 . 2)
		    (70 . 128)
		    (10 0 0 0)
		    (41 . 0.347296)
		    (10 -0.984807 0.0)
		    (40 . 0.347296)
		    (41 . 0.347296)
		   )
	 )
	 (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
	)
  )
  (cond	((and (setq e (entsel "\Pick a line: "))
	      (= "LINE" (cdr (assoc 0 (entget (car e)))))
	      (progn (initget 6) (or (setq sc (getdist "\nEnter scale: <3.0> ")) (setq sc 3.)))
	 )
	 (setq
	   p0 (vlax-curve-getclosestpointtoprojection (car e) (trans (cadr e) 1 (car e)) '(0. 0. 1.))
	 )
	 (setq e (entget (car e)))
	 (setq p1 (cdr (assoc 10 e)))
	 (setq p2 (cdr (assoc 11 e)))
	 (setq a (angle p1 p2))
	 (setq p1 (cond	((< (distance p1 p0) (distance p2 p0)) (list p1 (+ pi a)))
			((list p2 a))
		  )
	 )
	 (entmakex (list '(0 . "insert")
			 (cons 10 (car p1))
			 '(2 . "_ar")
			 (assoc 8 e)
			 (cons 50 (cadr p1))
			 (cons 41 sc)
			 (cons 42 sc)
			 (cons 43 sc)
		   )
	 )
	)
  )
  (princ)
)

 

Edited by ronjonp

Share this post


Link to post
Share on other sites
MS13

Sorry guys for keep you waiting for any reply.

ronjonp your routine works same as ahl - does not doing good in same way

I have attached drawing with lines where foo and ahl works and do not work 

1.dwg

Share this post


Link to post
Share on other sites
Roy_043

The lines are not co-planar with the WCS XY-plane and all have a non-zero delta Z.

Share this post


Link to post
Share on other sites
ronjonp
23 hours ago, MS13 said:

Sorry guys for keep you waiting for any reply.

ronjonp your routine works same as ahl - does not doing good in same way

I have attached drawing with lines where foo and ahl works and do not work 

1.dwg

Updated the code. Give it a try :)

Share this post


Link to post
Share on other sites
MS13

Thanks ronjonp, you did it again

Share this post


Link to post
Share on other sites
ronjonp

Glad to help :)

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×