View Full Version : Triangle
lalit_jangid
2011-10-31, 05:28 PM
Dear All,
I want to draw triangle through LISP Routine, I Have created some conditions by which we can successfully draw the triangle (by trignometry theorams). considering A B & C as three sides of triangle. & conditions are If A>B then A>C then B+C>A else B>C then A+C>B else C>A+B
if our inputs goes as per these conditions, triangle should be drawn as per data (A/B/C)
other wise it should exit the program showing "error in data input" error.
I Have written some lines, succueed in drawing one Line & two Circles, but please let me know how can i get point of the intersection of two circles.
I am posting the lisp file which i have created, then please you check the same & correct the same.
Thanks in Advance.
-Lalit
GHarvey
2011-11-01, 04:36 PM
Give the following a try; I have incorporated visual lisp methods, partly because they provide the easiest way of determining points of intersection between objects, and partly because this is my preferred approach ;)
It is dirty code, and does not include much in the way of error-handling, but perhaps you can make some use of it:
(defun c:tri ( / A2 ACT-SPACE B2 C2 OLDCMDECHO)
(vl-load-com)
(setq oldcmdecho (getvar "cmdecho"))
(or act-space
(setq act-space (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)
); vla-get-activedocument
); vla-get-activelayout
); vla-get-block
); setq
); or
(or a1 (setq a1 500))
(or b1 (setq b1 600))
(or c1 (setq c1 700))
(setvar "cmdecho" 1)
(initget 1)
(if (and (progn
(initget 1)
(if (vl-catch-all-error-p
(setq p1 (vl-catch-all-apply
'getpoint
(list "\nSpecify first point on Triangle: ")
); vl-catch-all-apply
); setq
); vl-catch-all-error-p
nil
T
); if
); progn
(cond ((vl-catch-all-error-p
(setq a2 (vl-catch-all-apply
'getreal
(list
(strcat
"\nLength of First Side of Triangle in mm<"
(vl-princ-to-string a1)
">:"
); strcat
); list
); vl-catch-all-apply
); setq
); vl-catch-all-error-p
nil
); user cancelled
((null a2) (setq a2 a1))
(T (setq a1 a2))
); cond
(cond ((vl-catch-all-error-p
(setq b2 (vl-catch-all-apply
'getreal
(list
(strcat
"\nLength of Second Side of Triangle in mm<"
(vl-princ-to-string b1)
">:"
); strcat
); list
); vl-catch-all-apply
); setq
); vl-catch-all-error-p
nil
); user cancelled
((null b2) (setq b2 b1))
(T (setq b1 b2))
); cond
(cond ((vl-catch-all-error-p
(setq c2 (vl-catch-all-apply
'getreal
(list
(strcat
"\nLength of Third Side of Triangle in mm<"
(vl-princ-to-string c1)
">:"
); strcat
); list
); vl-catch-all-apply
); setq
); vl-catch-all-error-p
nil
); user cancelled
((null c2) (setq c2 c1))
(T (setq c1 c2))
); cond
); and
(progn
(if (and (> a2 b2)
(> a2 c2)
(> (+ b2 c2) a2)
); and
(tri-draw)
(progn
(princ "\nInvalid Data for Triangle \nPlease Try again!")
); progn
); if
); progn
(princ "\nProgram Cancelled. ")
); if
(setvar "cmdecho" oldcmdecho)
(princ)
); defun
(defun tri-draw ( / CIR1 CIR2 CNTR INT-LST N P3 PT-LST)
(setq p2 (list (+ (car p1) a2) (cadr p1) 0)
cir1 (vla-addcircle act-space (vlax-3d-point p1) b2)
cir2 (vla-addcircle act-space (vlax-3d-point p2) c2)
int-lst (vlax-safearray->list
(vlax-variant-value
(vla-intersectwith cir1 cir2 acExtendnone)
); vlax-variant-value
); vlax-safearray->list
n 0
); setq
(vl-catch-all-apply 'vla-delete (list cir1))
(vl-catch-all-apply 'vla-delete (list cir2))
(while (< n (/ (length int-lst) 3))
(setq cntr (+ 0 (* n 3))
pt-lst (append pt-lst (list (list (nth cntr int-lst)
(nth (+ 1 cntr) int-lst)
(nth (+ 2 cntr) int-lst)
); list
); list
); append
n (1+ n)
); setq
); while
(setq p3 (if (> (cadadr pt-lst) (cadar pt-lst))
(cadr pt-lst)
(car pt-lst)
); if
); setq
(vla-addline act-space (vlax-3d-point p1) (vlax-3d-point p2))
(vla-addline act-space (vlax-3d-point p1) (vlax-3d-point p3))
(vla-addline act-space (vlax-3d-point p2) (vlax-3d-point p3))
); defun
alanjt
2011-11-01, 05:49 PM
GHarvey, you should be away that the get* functions (getreal, getint, getdist, getkword, getstring) will not error if nothing is entered.
eg.
Command: (getreal "\nSpecify number: ")
Specify number:
nil
No need for vl-catch*
GHarvey
2011-11-01, 06:26 PM
Actually, the vl-catch* is for instances when the user hits the escape key (which does generate an error).
alanjt
2011-11-01, 06:35 PM
Actually, the vl-catch* is for instances when the user hits the escape key (which does generate an error).
An escape would exit out of the entire command, not one get* call. To account for a user hitting escape, use and *error* handler.
GHarvey
2011-11-01, 06:52 PM
It would exit the command only if I was not capturing the error with vl-catch*. I prefer to handle errors where they occur, so that I can customize the response based on what is going on at the time. Granted, a generic *error* function would suffice in this case, but I've grown accustomed to writing functions that can offer other options when a particular block of code is cancelled. Call it a personal preference.
alanjt
2011-11-01, 06:57 PM
It would exit the command only if I was not capturing the error with vl-catch*. I prefer to handle errors where they occur, so that I can customize the response based on what is going on at the time. Granted, a generic *error* function would suffice in this case, but I've grown accustomed to writing functions that can offer other options when a particular block of code is cancelled. Call it a personal preference.
Whatever floats your boat. :) I don't see how your method yields any different return than a normal use of the get* functions other than a lot of conditionals and typing, since you don't do anything with your vl-catch info except return a nil to your and statement, but maybe I'm just missing something. More than anything, I just wanted to make sure you understood/were aware that you didn't need to wrap the get* functions with vl-catch*.
lalit_jangid
2011-11-06, 12:34 PM
you discuss your comments on other post, please reply me if any one have any idea.
-Lalit
devitg.89838
2011-11-06, 06:49 PM
you discuss your comments on other post, please reply me if any one have any idea.
-Lalit
Hi Lalit
Do you handle VL functions???
Bruno.Valsecchi
2011-11-07, 09:00 AM
let me know how can i get point of the intersection of two circles.
If can help you, my way for do this.
(defun 2xderr (ch)
(cond
((eq ch "Function cancelled") nil)
((eq ch "quit / exit abort") nil)
((eq ch "console break") nil)
(T (princ ch))
)
(setvar "cmdecho" v1)
(setvar "orthomode" v2)
(setvar "osmode" v3)
(setvar "blipmode" v4)
(setvar "plinewid" v5)
(setq *error* olderr)
(princ)
)
(defun c:2xd ( / v1 v2 v3 v4 v5 cc1 r1 cc2 r2 dce xi yi i cr1 cr2 vi xt yt h1 h2 h i1 i2 ss1 ss2 key olderr)
(setq v1 (getvar "cmdecho")
v2 (getvar "orthomode")
v3 (getvar "osmode")
v4 (getvar "blipmode")
v5 (getvar "plinewid")
)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "blipmode" 0)
(setvar "plinewid" 0)
(setq olderr *error* *error* 2xderr)
(initget 9)
(setq cc1 (getpoint "\nFirst base point ?: "))
(initget 9)
(setq cc2 (getpoint cc1 "\nSecond base point ?: "))
(grdraw cc1 cc2 1)
(initget 39)
(setq r1 (getdist cc1 "\nGive the first radius distance : "))
(initget 39)
(setq r2 (getdist cc2 "\nGive the second radius distance : "))
(grdraw cc1 cc2 0)
(setvar "osmode" 0)
(setq dce (distance cc1 cc2))
(if (= (rtos (/ dce (+ r1 r2)) 2 12) "1.000000000000")
(progn
(setq xi (/ (+ (* r2 (car cc1)) (* r1 (car cc2))) dce)
yi (/ (+ (* r2 (cadr cc1)) (* r1 (cadr cc2))) dce))
(setq i (cons xi (cons yi '(0.0))))
)
(if (and (not (zerop (- r1 r2))) (= (rtos (/ dce (abs (- r1 r2))) 2 12) "1.000000000000"))
(progn
(if (= r1 (max r1 r2))
(setq cr1 cc1 cr2 cc2)
(setq cr1 cc2 cr2 cc1)
)
(setq xi (/ (- (* (max r1 r2) (car cr2)) (* (min r1 r2) (car cr1))) dce)
yi (/ (- (* (max r1 r2) (cadr cr2)) (* (min r1 r2) (cadr cr1))) dce))
(setq i (cons xi (cons yi '(0.0))))
)
(progn
(if (or (> dce (+ r1 r2)) (< (+ (min r1 r2) dce) (max r1 r2)))
(prompt "\nNot intersections !...")
(progn
(setq vi (angle cc1 cc2))
(if (> r1 r2)
(setq xt (- (/ (* (+ r1 dce r2) (- (+ r1 dce) r2)) (* 2 dce)) r1)
yt (- dce xt)
h1 (sqrt (- (expt r1 2) (expt xt 2)))
h2 (sqrt (- (expt r2 2) (expt yt 2)))
xi (/ (+ (* yt (car cc1)) (* xt (car cc2))) dce)
yi (/ (+ (* yt (cadr cc1)) (* xt (cadr cc2))) dce)
)
(setq xt (- (/ (* (+ r2 dce r1) (- (+ r2 dce) r1)) (* 2 dce)) r2)
yt (- dce xt)
h1 (sqrt (- (expt r2 2) (expt xt 2)))
h2 (sqrt (- (expt r1 2) (expt yt 2)))
xi (/ (+ (* xt (car cc1)) (* yt (car cc2))) dce)
yi (/ (+ (* xt (cadr cc1)) (* yt (cadr cc2))) dce)
)
)
(setq h (/ (+ h1 h2) 2)
i1 (polar (cons xi (cons yi '(0.0))) (+ vi (/ pi 2)) h)
i2 (polar (cons xi (cons yi '(0.0))) (- vi (/ pi 2)) h)
)
(if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
(command "_.pline" cc1 i1 cc2 "")
(setq ss1 (ssget "_L"))
(command "_.pline" cc1 i2 cc2 "")
(setq ss2 (ssget "_L"))
(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE")))
(progn
(sssetfirst nil ss2)
(princ "\n<Move Cursor> for select; <Entrer>/[Space]/Rigth+Click for end!.")
(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
(cond
((eq (car key) 5)
(if (< (distance i1 (cadr key)) (distance i2 (cadr key)))
(sssetfirst nil ss1)
(sssetfirst nil ss2)
)
)
)
)
)
)
(command "_.erase")
)
)
)
)
)
(setvar "cmdecho" v1)
(setvar "orthomode" v2)
(setvar "osmode" v3)
(setvar "blipmode" v4)
(setvar "plinewid" v5)
(setq *error* olderr)
(prin1)
)
Lee Mac
2011-11-07, 12:37 PM
but please let me know how can i get point of the intersection of two circles.
Another for the intersection of two circles:
;; 2-Circle Intersection - Lee Mac
;; Returns the point(s) of intersection between two circles
;; with centres c1,c2 and radii r1,r2
(defun LM:Inters2Circle ( c1 r1 c2 r2 / n d1 x z )
(if (and (< (setq d1 (distance c1 c2)) (+ r1 r2)) (< (abs (- r1 r2)) d1))
(progn
(setq n (mapcar '- c2 c1)
c1 (trans c1 0 n)
z (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))
)
(if (equal z r1 1e-8)
(list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0))
(progn
(setq x (sqrt (- (* r1 r1) (* z z))))
(list
(trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
(trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
)
)
)
)
)
)
From my set of Geometric Functions (http://lee-mac.com/mathematicalfunctions.html#geometric).
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.