Arrow (lisp modification)

[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

[ronjonp]

Any reason you don't just use a leader?

[MS13]

Because I need to arrow some lines in the drawing 

[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

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

[BIGAL]

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

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

[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 February 8, 2019 by ronjonp

[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

[Roy_043]

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

[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

[MS13]

Thanks ronjonp, you did it again

[ronjonp]

Glad to help