Jump to content

OSNAP mode "_tan" to an ellipse


lido

Recommended Posts

;|
Author: Liviu Dovancescu
Rel.: 1.0
Date: 25.11.2018
Translating a straight line at the tangent point of the line with the ellipse
The point PE is not (yet) used.
Limitations:
The plane of ellipse parallel with the plane xOy (Z=constant)
Tests:
 - AutoCAD 2005 SP 1:
	- none command active: OK
	- a command active and grips actives: OK
	- a command active and grips inactives: ERROR regarding selected objects
 - ZWCAD 2018 Version number 2018.03.16(29562)_x64:
	- none command active: OK
	- a command active: FAIL because of function SEL-ATPT
|;
(DEFUN MTEL	(/
;;Functions
						*ERROR*
						AFI-MESA
						COP-DETM
						INT-CEDR
						SEL-ATPT
						TAN-DREL
						TIP-ENTI
;;Variables
						A AA AF AG
						B BB
						C CC CMD
						D DD DL
						E EL
						F1
						HLL
						I
						LN
						M
						OA OC OO
						PE PL
						SL SS
						T1 T2
						XO
						YO
						ZO
					)

;;Error function
	(DEFUN *ERROR* (s)
		(if HLL (vla-highlight LN :vlax-false))
		(if SS (sssetfirst nil))
		(if (not (wcmatch (strcase s) "*BREAK*,*CANCEL*,*EXIT*"))
			(prompt (strcat "\nError: " s))
		)
		(princ)
	) ;;*ERROR*

;;Print the message x on " Command:" prompt
	(DEFUN AFI-MESA (x)
		(if HLL (vla-highlight LN :vlax-false))
		(prompt (strcat "\n" x))
		(princ)
	) ;;AFI-MESA

;; Matrix Determinant (Upper Triangular Form)  -  Elpanov Evgeniy
;; Args: m - nxn matrix
;;Determinant m computation
	(DEFUN COP-DETM (m / d)
		(cond
			(	(null m) 1)
			(	(and	(zerop (caar m))
						(setq d (car (vl-member-if-not (function (lambda (y) (zerop (car y)))) (cdr m))))
				)
				(COP-DETM (cons (mapcar (function +) (car m) d) (cdr m)))
			)
			(	(zerop (caar m)) 0)
			(	(*	(caar m)
					(COP-DETM
						(mapcar
							(function
								(lambda (y / d) (setq d (/ (car y) (float (caar m))))
									(mapcar
										(function (lambda (b c) (- b (* c d))))
										(cdr y) (cdar m)
									)
								)
							)
							(cdr m)
						)
					)
				)
			)
		)
	) ;;COP-DETM

;;Intersection between the circle (er, C (xc, yc, zc)) and the straight line
;;passing through (xf, yf) and having the slope em
;;Result: list ((x1 y2)(x2 y2))
	(DEFUN INT-CEDR (xc yc zc er xf yf em / ae be de en)
		(setq en	(- yf (* em xf))
				ae	(+ 1. (expt em 2.) )
				be	(+ (* -1. em en) (* em yc) xc)
				de	(sqrt
						(+
							(expt er 2.)
							(expt (* em er) 2.)
							(* -1. (expt en 2.))
							(* -1. (expt yc 2.))
							(* -1. (expt (* xc em) 2.))
							(* 2. en yc)
							(* -2. en em xc)
							(* 2. em xc yc)
						)
					)
		)
		(mapcar
			(function
				(lambda (x) (list x (+ (* em x) yf (* -1. em xf)) zc))
			)
			(list (/ (- be de) ae) (/ (+ be de) ae))
		)
	) ;;INT-CEDR

;;On screen entity selection (entity type as per listTip) and prompting the text txt at "Command:" prompt
;;Example: (SEL-ATPT "\nSelect a line:" (list "AcDbLine"))
;;Result: list ((x y z) #<VLA-OBJECT ....>) if the entity type belongs to listTip, otherwise (nil nil). The point (x y z) belongs to the selected entity.
	(DEFUN SEL-ATPT (txt listTip / ObjSelected screenPoint ssetObj)
		(setq ssetObj	(vla-add
								(vla-get-selectionsets
									(vla-get-activedocument
										(vlax-get-acad-object)
									)
								)
								(substr (rtos (getvar "CDATE") 2 9) 10)
							)
		)
		(prompt txt)
		(while  (not ObjSelected)
			(if
				(setq screenPoint
					(if
						(vl-catch-all-error-p
							(vl-catch-all-apply
								(function
									(lambda ()
										(while (/= 3 (car (setq screenPoint (grread nil 15 2))))
											nil
										)
									)
								)
							)
						)
						nil
						(cadr screenPoint)
					)
				)
				(vla-selectatpoint ssetObj (vlax-3d-point screenPoint))
			)
			(setq ObjSelected
				(if (= (vla-get-count ssetObj) 1) ;;Numai fata de un singur obiect se poate construi tangenta la elipsa
					(vla-item ssetObj 0)
				)
			)
		)
		(vla-delete ssetObj)
		(list
			(if (and ObjSelected (vl-position (vla-get-objectname ObjSelected) listTip)) ;;Urmeaza si alte tipuri de entitati in ltip
				(vlax-curve-getclosestpointto ObjSelected (trans screenPoint 1 0)) ;;Punctul de selectie pe entitatea selectata in WCS
				(setq ObjSelected nil) ;;Anulare selectie
			)
			ObjSelected
		)
	) ;;SEL-ATPT

;;Tangent point of the stright line passing through point ls and having the slope em with the ellipse (E)=f(x1 x2 x3 x4 x5)
;;Result: list (xT yT), where xT and yT are the coordinates of tangent point T
;;Example (TAN_DREL A B C D E (list XD YD ZD) M)
	(DEFUN TAN-DREL (x1 x2 x3 x4 x5 ls em / en xd xt yd)
		(setq xd (car  ls)
				yd (cadr ls)
				en (- yd (* em xd))
				xt (/
						(+ (* x2 en) (* 2. x3 em en) x4 (* x5 em))
						-2.
						(+ x1 (* x2 em) (* x3 (expt em 2.)))
					)
		)
		(list xt (+ (* em xt) yd (* -1. em xd)) (caddr ls))
	) ;;TAN-DREL

;;Check if the entity passing through point x, member of the selection set s, is a member af listTip
;;The colinearity condition of 3 points is checked.
;;Example: (TIP-ENTI (trans (getvar "LASTPOINT") 1 0) SS (list "AcDbLine"))
;;Result: #<VLA-OBJECT IAcadLine ....> or nil 
	(DEFUN TIP-ENTI (x s listTip / ep li sp)
		(vlax-for SSobj s
			(if (vl-position (vla-get-objectname SSobj) listTip )
				(progn
					(setq
						sp (vlax-safearray->list (vlax-variant-value (vlax-get-property SSobj "StartPoint")))
						ep (vlax-safearray->list (vlax-variant-value (vlax-get-property SSobj "EndPoint"  )))
					)
					(if
						(equal
							(COP-DETM ;;conditia de colinearitate sp, ep si x
								(if (and (equal (caddr x) 0. 1E-7) (equal (caddr sp) 0. 1E-7) (equal (caddr ep) 0. 1E-7))
									(list
										(list (car sp) (cadr sp) 1)
										(list (car ep) (cadr ep) 1)
										(list (car  x) (cadr  x) 1)
									)
									(list sp ep x)
								)
							)
							0.
							1E-7
						)
						(setq li SSobj)
					)
				)
			)
		)
		(vla-delete s)
		li
	) ;;TIP-ENTI

;;Main
	(setq CMD (if (= (getvar "CMDACTIVE") 1) T)) ;;Flag comanda activa
;|
(alert
(strcat
"1. CMDACTIVE: "
(itoa (getvar "CMDACTIVE"))
"\n2. CMDNAMES: "
(getvar "CMDNAMES")
"\n3. Grips inactives: "
(itoa (vlax-get-property (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))) "Count"))
"\n4. Grips actives:   "
(itoa (vlax-get-property (vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object))) "Count"))
)
)
|;
;;Line selection
	(if CMD ;;Test comanda activa
		(progn 
			(if (= (vlax-get-property (setq SS (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) "Count") 0) ;;Grips inactives
				(setq SS (vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object)))) ;;Grips actives
			)
			(setq LN (TIP-ENTI (trans (getvar "LASTPOINT") 1 0) SS (list "AcDbLine"))) ;;Test obiect selectat=linie
		)
		(mapcar
			(function set)
			(list (quote PE) (quote LN))
			(SEL-ATPT "\nSelect line:" (list "AcDbLine"))
		)
	)
;;Ellipse selection
	(if LN
		(progn
			(if (not CMD)
				(progn
					(vla-highlight LN :vlax-true) ;;Linie aprinsa
					(setq HLL T) ;;Flag linie aprinsa
				)
			)
			(mapcar
				(function set)
				(list (quote PL) (quote EL))
				(SEL-ATPT (if CMD "\n_tan to Ellipse:" "\nSelect Ellipse:") (list "AcDbEllipse"))
			)
			(if EL
				(progn
;;Line and ellipse selected
					(setq
;;Ellipse
						OA	(vlax-get-property EL "MajorRadius") ;;|OA|
						OC	(vlax-get-property EL "MinorRadius") ;;|OC|
						OO	(vlax-safearray->list (vlax-variant-value (vlax-get-property EL "Center"))) ;;Center O
						XO	(car   OO)
						YO	(cadr  OO)
						ZO (caddr OO)
						AF	(vla-anglefromxaxis
								(vla-get-utility (vla-get-activedocument (vlax-get-acad-object)))
								(vlax-3d-point 0. 0. 0.)
								(vlax-get-property EL "MajorAxis") ;;Angle in radians between Ox and AB
							)
						AA	(polar OO AF OA) ;;Point A
						BB	(polar OO (- AF pi) OA) ;;Point B
						CC	(polar OO (- AF (* 0.5 pi)) OC) ;;Point C
						DD	(polar OO (+ AF (* 0.5 pi)) OC) ;;Point D
						F1	(polar OO AF (sqrt (- (expt OA 2.)(expt OC 2.)))) ;;Foci F1
;;Line
						SL (vlax-safearray->list (vlax-variant-value (vlax-get-property LN "StartPoint"))) ;;Start point line
						DL (vlax-safearray->list (vlax-variant-value (vlax-get-property LN "EndPoint"  ))) ;;End point line
						AG (vlax-get-property LN "Angle")
					)					
					(if
						(and
							(equal;;Punctele A, C, SL si DL coplanare
								(COP-DETM
									(mapcar
										(function
											(lambda (x) (append x (quote (1))))
										)
										(list AA CC SL DL)
									)
								)
								0.
								1E-7
							)
							(= (caddr AA) (caddr BB) (caddr CC) (caddr DD));;  (E) || (xOy)
						)
						(progn
							(setq 
;;Coefficients of the ellipse general equation in 2D
								A	(+ (expt (* OA (sin AF)) 2.) (expt (* OC (cos AF)) 2.)) ;;A=OA^2*sin^2(af)+OC^2*cos^2(af)
								B	(* 2. (- (expt OC 2.) (expt OA 2.)) (sin AF) (cos AF)) ;;B=2*(OC^2-OA^2)*sin(af)*cos(af)
								C	(+ (expt (* OA (cos AF)) 2.) (expt (* OC (sin AF)) 2.)) ;;C=OA^2*cos^2(af)+OC^2*sin^2(af)
								D	(* -1. (+ (* 2. A XO) (* B YO))) ;;D=-2*A*XO-B*YO
								E	(* -1. (+ (* 2. C YO) (* B XO))) ;;E=-2*C*YO-B*YO
							)
							(cond
								((equal (sin AG) 0. 1E-7) ;;(D) || Ox
									(mapcar
										(function set)
										(list (quote T1) (quote T2))
										(mapcar
											(function
												(lambda (y) (list (/ (+ (* B y) D) -2. A) y ZO))
											)
											(list
												(+ YO (sqrt (- (expt OA 2.) (expt (- (car F1) XO) 2.))))
												(- YO (sqrt (- (expt OA 2.) (expt (- (car F1) XO) 2.))))
											)
										)
									)
								)
								((equal (cos AG) 0. 1E-7) ;;(D) || Oy
									(mapcar
										(function set)
										(list (quote T1) (quote T2))
										(mapcar
											(function
												(lambda (x) (list x (/ (+ (* B x) E) -2. C) ZO))
											)
											(list
												(+ XO (sqrt (- (expt OA 2.) (expt (- (cadr F1) YO) 2.))))
												(- XO (sqrt (- (expt OA 2.) (expt (- (cadr F1) YO) 2.))))
											)
										)
									)
								)
								((not (inters SL DL AA BB nil)) (setq T1 CC T2 DD)) ;;(D) || AB
								((not (inters SL DL CC DD nil)) (setq T1 AA T2 BB)) ;;(D) || CD
								(T ;;Linia nu e paralela cu axele elipsei si nici cu axele de coordonate Ox sau Oy
									(setq M	(/ (sin AG) (cos AG))
											I	(INT-CEDR XO YO ZO OA (car F1) (cadr F1) (/ -1. M))
											T1	(TAN-DREL A B C D E (car  I) M)
											T2	(TAN-DREL A B C D E (cadr I) M)
									)
								)
							)
;;User interface
							(if CMD
								(progn
									(setq
											PL	(trans PL 0 1) ;;In UCS
											T1	(trans T1 0 1) ;;In UCS
											T2	(trans T2 0 1) ;;In UCS
									)
									(osnap
										(if (< (distance T1 PL) (distance T2 PL)) T1 T2)
										"_non"
									)
								)
								(progn
									(setq SS (ssadd))
									(mapcar ;;Lista->Set de selectie
										(function (lambda (x) (setq SS (ssadd x SS))))
										(mapcar ;;Desenare puncte
											(function
												(lambda (x)
													(entmakex
														(append
															(mapcar
																(function cons)
																(list 	0 			100 						67 								8  			100)
																(list "POINT" "AcDbEntity" (if (= (getvar "TILEMODE") 1) 0 1)  "Defpoints"	"AcDbPoint")
															)
															x
														)
													)
												)
											)
											(list (list (cons 10 T1)) (list (cons 10 T2)))
										)
									)
									(sssetfirst nil SS) ;;Aprinde grip-uri
									(setq SS nil)
									(vla-highlight LN :vlax-false) ;;Stinge linie
									(princ)
								)
							)
						)
						(AFI-MESA "The Line and the Ellipse are not coplanar or the plan of Ellipse is not parallel to the plane xOy.")
					)
				)
				(AFI-MESA "Selected entity is not an Ellipse.")
			)
		)
		(AFI-MESA "Only Line allowed.")
	)
)

Under AutoCAD, the OSNAP mode _tan works OK in case of the circle. Not in case of the ellipse.

I am talking about the translation of the selected object at the tangent point with an ellipse.

The above code tries to solve this problem. The geometric solution is the one in the attached drawing.

If no command active, the program draws the tangent points of a selected straight line with the ellipse.

If a command is active (OSNAP mode) and the program is invoked, it works well only if grips are active (fired).  Otherwise (inactive grips), the selected items in the active command are lost, in the selection set remaining the ellipse.

A tricky solution would be by saving the selection set from the active command, the command name, and restoring the context after the ellipse was selected.
Please test the program and give me a hand.

 

Thank you in advance.

Ellipse.dwg

Link to comment
Share on other sites

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.

×
×
  • Create New...