lido Posted November 25, 2018 Posted November 25, 2018 ;| 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 Quote
Recommended Posts
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.