snap/trim/extend orthogonally?

[dlbsurveysuk]

I have a few Lisp routines that draw an arrow nearest to nearest, and add various annotations midpoint on the arrow.

Would it be possible to make the routines snap nearest and then snap/trim/extend to the second line orthogonally to the drawing (as on the right in the image)

Sample Lisp attached.

Thanks.

[ВeekeeCZ · Accepted solution]

If the second object is non-arc, then something simple as this... 

(defun c:neaorto ()
  (setvar 'orthomode 0)
  (setvar 'osmode 512)
  (setq f (getpoint "Nearest: "))
  (setvar 'orthomode 1)
  (setq s (getpoint f "Second: "))
  (setq x (inters f (polar f (/ pi 2) 1) (osnap s "nea") (osnap s "end") nil))
  (command "_line" "_non" f "_non" x "")
  (princ)
  )

Add sysvar reset expresions...

[dlbsurveysuk]

Ah ok. I wasn't thinking about it in the right way. I knew there must be a fairly simple solution -

inters !

Thanks.

[dlbsurveysuk]

Is there a solution for arcs? This can happen.

Thanks.

[ВeekeeCZ]

Just to show you how, make it nicer.

https://www.lee-mac.com/intersectionfunctions.html

(defun c:neaorto ()

  ;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst))))
    (reverse rtn)
)

  
  (setvar 'orthomode 1)
  (setvar 'osmode 512)
  (setq f (getpoint "Nearest: "))
  (setq s (getpoint f "Second: "))
  (setq o (car (nentselp s)))
  (command "line" "_non" f "_non" (polar f (/ pi 2) 1) "")
  (setq e (entlast))
  (setq x (car (LM:intersections (vlax-ename->vla-object e) (vlax-ename->vla-object o) acextendthisentity)))
  (command "_line" "_non" f "_non" x "")
  (entdel e)
  (princ)
  )

[dlbsurveysuk]

Your first answer I could understand and it incorporated into my original routine without any problems.

This second one I don't understand and testing it as a standalone it doesn't seem to work?

I'm getting a line from first/nearest  - length approx 700m at angle approx 49 degrees ... (tested on a line and an arc approx 1m apart)

[ВeekeeCZ]

Maybe you need to add (vl-load-com)?

[dlbsurveysuk]

OK. Yes that cured that problem...

But now if if my second pick near to the arc is very nearly orthogonal, there is a small gap between the end of the arrow line and the arc. The further across (-x or +x) I go with my second pick the bigger the gap becomes (arrow line becomes shorter).

[ВeekeeCZ]

Ilustrate.

Not having such an issue. You need to click on the second object with the nearest osmode applied. The first one could be anywhere.

[dlbsurveysuk]

Apologies. It's working fine. If in WCS.

I was testing in a UCS... I spend most of my time in various UCSs, so the routine needs to work in any UCS. Your first answer seemed to work fine in a UCS.

Does this mean use of the TRANS command is needed? If so I'm unsure of how to implement it.

[ВeekeeCZ · Accepted solution]

It's just x that comes in WCS. 

(command "_line" "_non" f "_non" (trans x 0 1) "")

[komondormrex]

hey there,

given the arrow block is defined similar to that of below.

you may make it half dynamic with regards to usc set. no system var is however touched)

(defun c:clg (/ s_point line arrow e_point text rotation)
	(setq s_point (getpoint "\nStart point: ")
		  line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
	                  					   (vlax-3d-point (trans s_point 1 0))
	                  					   (vlax-3d-point (trans s_point 1 0))
	           )
		  arrow	(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  	 (vlax-3d-point s_point)
								 "ArHead"
							  	 1 1 1 0
				)
	)
	(entmod (subst (cons 8 "gtext") (assoc 8 (setq line_dxf (entget (vlax-vla-object->ename line)))) line_dxf))
	(while (and (setq e_point (grread t 5 2)) (/= 3 (car e_point)))
		(setq e_point (cadr e_point))
		(vla-put-endpoint line (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
		(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
		(vla-put-rotation arrow (setq rotation (angle (trans s_point 1 0) (trans (list (car s_point) (cadr e_point) 0) 1 0)))) 
	)
	(setq e_point (cadr e_point))
	(vlax-put line 'endpoint (vlax-invoke line 'intersectwith (vlax-ename->vla-object (car (nentselp e_point))) acextendthisentity))
	(vla-put-insertionpoint arrow (vla-get-endpoint line))
	(vla-put-layer arrow "gtext") 
	(setq text (vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))                     
						 	"Clg Dn"
						 	(setq text_alignment_point (vlax-3d-point (polar (vlax-get line 'startpoint) 
																			 rotation 
																			 (* 0.5 (distance (vlax-get line 'startpoint) (vlax-get line 'endpoint)))
																	  )
													   )
							)
							(getvar 'textsize)
			   )
	)
	(vla-put-alignment text 4)
	(vla-put-rotation text (+ rotation (* 0.5 pi)))
	(vla-put-textalignmentpoint text text_alignment_point)
	(vla-put-layer text "gtext")
	(princ)
)

[dlbsurveysuk]

I've incorporated your code into the original and it works perfectly. Thanks very much for your help.

[dlbsurveysuk]

Hi, I've modified your code slightly so that the first point snaps to nearest and the arhead block is at the correct scale.

I like the idea but currently the arhead is rotated incorrectly in WCS, and both the arhead and the text are incorrect in a UCS (see images below) and I can't figure out how to correct this.

Also I really do want the arrow line to break around the text as per the original routine.

Thanks for your time.

(defun c:clg (/ s_point line arrow e_point text rotation)

   (setq ts (getvar 'textsize))
   (setvar 'osmode 512)

	(setq s_point (getpoint "\nStart point: ")
		  line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
	                  					   (vlax-3d-point (trans s_point 1 0))
	                  					   (vlax-3d-point (trans s_point 1 0))
	           )
		  arrow	(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  	 (vlax-3d-point s_point)
								 "ArHead"
							  	 ts ts ts 0
				)
	)
	(entmod (subst (cons 8 "gtext") (assoc 8 (setq line_dxf (entget (vlax-vla-object->ename line)))) line_dxf))
	(while (and (setq e_point (grread t 5 2)) (/= 3 (car e_point)))
		(setq e_point (cadr e_point))
		(vla-put-endpoint line (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
		(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
		(vla-put-rotation arrow (setq rotation (angle (trans s_point 1 0) (trans (list (car s_point) (cadr e_point) 0) 1 0)))) 
	)
	(setq e_point (cadr e_point))
	(vlax-put line 'endpoint (vlax-invoke line 'intersectwith (vlax-ename->vla-object (car (nentselp e_point))) acextendthisentity))
	(vla-put-insertionpoint arrow (vla-get-endpoint line))
	(vla-put-layer arrow "gtext") 
	(setq text (vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))                     
						 	"Clg Dn"
						 	(setq text_alignment_point (vlax-3d-point (polar (vlax-get line 'startpoint) 
																			 rotation 
																			 (* 0.5 (distance (vlax-get line 'startpoint) (vlax-get line 'endpoint)))
																	  )
													   )
							)
							ts
			   )
	)
	(vla-put-alignment text 4)
	(vla-put-rotation text (+ rotation (* 0.5 pi)))
	(vla-put-textalignmentpoint text text_alignment_point)
	(vla-put-layer text "gtext")
	(princ)
)

[ВeekeeCZ]

---

@dlbsurveysuk wrote:

... I've modified your code slightly so that the first point snaps to nearest ...

(defun c:clg (/ s_point line arrow e_point text rotation)

   (setq ts (getvar 'textsize))
   (setvar 'osmode 512)

...
	(princ)
)

---

Just a good advice. If you have to change the setting of a system variable in your routine, always make sure to reset its setting back when finished. You might not mind now because you are aware of it, but over time, when you have a lot of routines, you forget about it and create a very unpredictable environment. Just saying. 
And yes, if I don't do it in my example, I assume you'll do it yourself.

[dlbsurveysuk]

Yes re. resetting variables. I usually do. Was just a rushed test. Thanks.

[dlbsurveysuk]

Hi,

I've now modified your original code so that the first point snaps to nearest, the arhead block is at the correct scale, and both the text and arhead are rotated correctly.

I've also added some code at the end that trims the arrow line around the text using "textbox". Finally got this to work after realising that I need to covert the vla-object to an ename using "vlax-vla-object->ename".

I've also modified your code into a second routine that works for drawing an arrow horizontally instead of vertically.

Both these work in WCS and any UCS where the xy plane is rotated around the z axis.

A problem occurs when I have a UCS where the zx or zy plane is rotated (see image).

I can't seem to figure it out. Any help appreciated. Thanks.