TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TopoWAR on December 15, 2011, 04:07:11 PM
-
Hello to all! Anyone know how to calculate from a given area lisp a parallel line, I show an example, thanks
-
Maybe this will help you:
http://www.theswamp.org/index.php?topic=37824.msg428670#msg428670
-
ronjonp , thanks for replying, but not what I am concerned, I need to calculate an area based on a parallel line, let's see who help me, thanks
-
Can't you select the two parallel lines, sort the endpoints, and use AT:AreaFromPoints to get the area?
-
ronjonp , see this sample video:
-
I don't understand how you are creating the polygon.
But that is what you want the area of?
-
Or are you trying to determine the position of the parallel line based on a set area?
-
Lee Mac , correct master
example:
1 - (getpoint) point 1 = p1
2 - (getpoint) point 2 = p2
3 - (getpoint) first address = p3
4 - (getpoint) second address p4
5 - Enter the area to calculate: eg 15000
6 - calculate 2 new items to the area indicated, using the pt1 to pt2 parallel
thanks for your patience
climb another clear example
-
very handy if this could be done, I always resort to offsetting a little at a time.
-
Very perceptive of you Lee. 8-)
Given the end points of two lines and the area desired it should not be too difficult to do.
I think I remember a similar thread.
No time this morning but I'm sure someone will offer a solution.
-
Hi TopoWAR,
maybe this one is helpful for you. It`s not my work, I found it on the web, but don`t remember where....
-
adam_s , more than excellent, thanks for help :lol:
-
Here is my quick derivation for those who want to code it:
(http://www.theswamp.org/lilly_pond/leemac/AreaDerivation.png)
[ Excuse my dimensioning | programmer not draftsman ]
-
THIS?
http://www.gr-acad.com.br/Pacote/efpac0206.html
-
done...
-
Hi,
Here's a quick and dirty, l1 and l2 have to be vla-objects (IAcadLine)
(defun area (l1 l2)
(vl-load-com)
(/
(*
(+ (vla-get-Length l1) (vla-get-Length l2))
((lambda (p)
(distance p (vlax-curve-getClosestPointTo l2 p T))
)
(vlax-curve-getStartPoint l1)
)
)
2.
)
)
-
hello, here asking for your valuable help.
routine does not work well when calculating 5000m2
anyone can help me to correct it?
thanks
(defun ang_between (p10 p11 p20 p21 / px p1 p2 l_pt l_d p ang)
(setq px (inters p10 p11 p20 p21 nil))
(cond
(px
(if (> (distance px p10) (distance px p11)) (setq p1 p10) (setq p1 p11))
(if (> (distance px p20) (distance px p21)) (setq p2 p20) (setq p2 p21))
(setq
l_pt (list px p1 p2)
l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt))))
p (/ (apply '+ l_d) 2.0)
ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0)
)
)
(T
nil
)
)
)
(defun c:divarea ( / pt1 pt2 pt3 pt4 S1 ang1 ang2 x1 x2 ptx1 ptx2)
(setq pt1 (getpoint "\nFirst point of baseline: "))
(setq pt2 (getpoint pt1 "\nSecond point of baseline: "))
(setq pt3 (getpoint pt1 "\nPoint of first adjacent side: "))
(setq pt4 (getpoint pt2 "\nPoint of second adjacent side: "))
(setq S1 (getreal "\nWanted area: "))
(setq ang1 (ang_between pt1 pt2 pt1 pt3))
(setq ang2 (ang_between pt2 pt1 pt2 pt4))
(setq ang1 (- pi ang1) ang2 (- pi ang2))
(setq x1
(*
(/
(* (distance pt1 pt2) (sin ang1))
(sin (+ ang1 ang2))
)
(1-
(+ ;or can be "-"
(sqrt
(1+
(/
(* 2.0 S1 (sin (+ ang1 ang2)))
(* (distance pt1 pt2) (distance pt1 pt2) (sin ang1) (sin ang2))
)
)
)
)
)
)
)
(setq x2 (/ (* x1 (sin ang2)) (sin ang1)))
(setq ptx1 (polar pt1 (angle pt1 pt3) x2))
(setq ptx2 (polar pt2 (angle pt2 pt4) x1))
(command "_.line" "_none" ptx1 "_none" ptx2 "")
)
Please see the example
-
Here's a rewrite, hopefully avoiding several errors:
*EDIT* - Added Comments
;; Local defun: angle from three points, as interior value (dgorsman)
(defun get< ( pt1 vertex pt2 / return_angle angle1 angle2 )
(if
(< (setq return_angle (- (angle vertex pt1) (angle vertex pt2))) 0)
(setq return_angle (+ (* pi 2) return_angle)))
(min (- (* pi 2) return_angle) return_angle)
)
(defun AddLWPline (spc pts);(cmwade77)
(setq pts (apply 'append (mapcar '(lambda (pt) (list (car pt) (cadr pt))) pts))
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts)))
(vla-addlightweightpolyline spc pts)
)
;-----------------------------------------------------------------------------------------
;(jvillarreal)
(defun c:CA ( / Doc Mspc pt1 pt2 pt3 pt4 ang1 tanang1 ang2 tanang2
a b num1 DesiredArea div AreaNumber a1 a2 PerpDist)
(vl-load-com)
(while (not pt1)
(setq pt1 (getpoint "\nSelect 1st Base Point:")))
;Require distance btwn base pts
(while (or (not pt2)(zerop (setq b (* 2 (distance pt1 pt2)))))
(setq pt2 (getpoint "\nSelect 2st Base Point:")))
;Require distance/angle btwn pt1&pt3
(while (or (not pt3)(zerop (distance pt1 pt3))
(zerop (rem (- (angle pt1 pt2)(angle pt1 pt3)) pi)))
(setq pt3 (getpoint pt1 "\nPoint on 1st Adjacent Side:")))
;Require distance/angle btwn pt2&pt4
(while (or (not pt4)(zerop (distance pt2 pt4))
(zerop (rem (- (angle pt2 pt1)(angle pt2 pt4)) pi)))
(setq pt4 (getpoint pt2 "\nPoint on 2nd Adjacent Side:")))
(setq Doc (vla-get-activedocument (vlax-get-acad-object))
Mspc (vla-get-modelspace Doc)
;save angles for polar projection
a1 (angle pt1 pt3) a2 (angle pt2 pt4)
;Use interior angle to determine addition or subtraction of triangular area(s)
ang1 (- (get< pt3 pt1 pt2)(/ pi 2))
tanang1 (/ (sin ang1)(cos ang1));right triangle base/height
ang2 (- (get< pt1 pt2 pt4)(/ pi 2))
tanang2 (/ (sin ang2)(cos ang2))
a (+ tanang1 tanang2)
num1 (if (not (equal a 0 1e-10))(/ (expt b 2) (* -8 a)));trapezoid?
;If not trapezoid or rectangle, area is a parallelogram
;Area of a parallelogram = base * height
;Calculate perpedicular distance from pt2 to "pt1->pt3 line" as base,
; height will then be required distance along "pt1->pt3 line"
PerpDist (if (and (not num1)(not (zerop (- ang1 ang2))))(* b 0.5 (sin (- (/ pi 2)(abs ang1))))))
;Require valid Area
;Area greater than 0 entered?
(while (or (not DesiredArea)(zerop DesiredArea)
;within limit if one exists?
(not (if (< num1 0)(> DesiredArea num1)(< DesiredArea num1))))
(setq DesiredArea nil
DesiredArea
(getreal
(if num1;if limit exists, notify user
(strcat "\nEnter Area" (if (< num1 0) " GREATER than " " LESS than ")
(rtos num1 2 20) ":")
"\nEnter Area:"))))
;Prompt for valid Number of areas
(setq AreaNumber
;Check for limit
(if (or (not num1)(< DesiredArea 0 num1)(< num1 0 DesiredArea)(>= (setq div (/ num1 DesiredArea)) 2))
(getint
(strcat "\nEnter Number of Areas to create:"
(if (>= div 2);if limit exists, notify user
(strcat "(1-" (itoa (fix div))")")
""))) 1))
;Require valid Number of areas
(if div
;prompt while limit is exceeded or invalid Number is entered
(while (not (>= (fix div) AreaNumber 1))
(setq AreaNumber (getint (strcat "\nMust be 1-" (itoa (fix div))":")))))
(vla-endundomark doc)
(vla-startundomark doc)
(repeat AreaNumber
(setq b (* 2 (distance pt1 pt2))
c (* -2 DesiredArea)
;if trapezoid, use quadratic formula to determine height
x (if num1 (/ (- (sqrt (- (expt b 2) ( * 4 a c))) b)(* 2 a)))
;if trapezoid, calc distance along legs, else calc rectang height by area/base
p1 (if num1 (/ x (cos ang1))(/ DesiredArea b 0.5))
;if parallelogram, acquire height by area/perpdist
p1 (if perpdist (/ DesiredArea perpdist) p1)
p2 (if num1 (/ x (cos ang2)) p1)
p1 (polar pt1 a1 p1);project point
p2 (polar pt2 a2 p2)
ptlst (mapcar '(lambda (pt)(trans pt 1 0)) (list p1 pt1 pt2 p2))
pt1 p1 pt2 p2)
(vla-put-closed (AddLwpline Mspc ptlst) :vlax-true)
)
(vla-endundomark doc)
(princ)
)
-
TopoWAR,
Just looked at your dwg and apparently the code works for the 90 degree angles but needs work for the parallelogram..
-
jvillarreal , thank you very much for helping me, it works excellent
-
No problem. I've also revised the code provided to work with your parallelogram.
-
jvillarreal , I realized, works great.
use a translator from Spanish to English, blame the translator for errors