TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: T.Willey on December 09, 2010, 04:49:32 PM
-
Inspired by this post over at the Adesk Ng - http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Find-included-angles-of-Pline/td-p/2847672
I thought it would be a fun challenge, that wasn't too hard, but I got a little more than I thought I would. I have a solution already, posted in that thread, but wondered how others would tackle it. One of the issues was getting the angle value of 289 instead of 71, as shown in the pic attached.
-
(defun vk_GetLeftAngle (p1 p2 p3 / Ang)
(if (minusp (setq Ang (rem (+ pi (angle p2 p1) (- (angle p3 p2))) (* pi 2.0))))
(+ pi pi Ang)
Ang
)
)
(defun test (/ lst)
(setq lst (mapcar 'cdr
(vl-remove-if-not (function (lambda (e) (= (car e) 10)))
(entget (car (entsel)))
)
)
)
(mapcar (function
(lambda (p1 p2 p3 / Ang) (angtos (- (* 2 pi) (vk_GetLeftAngle p1 p2 p3))))
)
(cons (last lst) lst)
lst
(append (cdr lst) (list (car lst)))
)
)
had vk_GetLeftAngle already in my libs
-
I guess you would just need to test which way the polyline goes then Vovka?
I like how you get the angle. I didn't think of that one, and I tried a couple.
-
yes, he's generally very frugal.
:-)
-
VovKa,
After studying your code, would this also work for the GetLeftAngle?
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
-
Not too imaginative, and using most of VovKa's code:
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m )
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel))))))
(setq l
(mapcar '(lambda ( p1 p2 p3 ) (LM:GetLeftAngle p1 p2 p3))
(cons (last l) l) l (append (cdr l) (list (car l)))
)
)
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
-
I guess you would just need to test which way the polyline goes then Vovka?
then i will need something like...
(defun vk_IsBoundaryClockwise (CoordsList)
(minusp
(apply '+
(mapcar (function
(lambda (p1 p2)
(* (+ (car p1) (car p2)) (- (cadr p1) (cadr p2)))
)
)
CoordsList
(cons (last CoordsList) CoordsList)
)
)
)
)
VovKa,
After studying your code, would this also work for the GetLeftAngle?
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
i think it perfectly will
-
Not too imaginative, and using most of VovKa's code:
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m )
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel))))))
(setq l
(mapcar '(lambda ( p1 p2 p3 ) (LM:GetLeftAngle p1 p2 p3))
(cons (last l) l) l (append (cdr l) (list (car l)))
)
)
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
I like your program, I want to shorten it a bit:
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m )
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel))))))
(setq l (mapcar 'LM:GetLeftAngle (cons (last l) l) l (append (cdr l) (list (car l)))))
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
as an alternative, I propose a different approach:
(defun c:test (/ e)
(if (setq e (car (entsel)))
(reverse (f e (1- (cdr (assoc 90 (entget e)))) 0))
)
)
(defun f (e i1 i2)
(if (>= i1 0)
(cons (angtos (rem (+ pi
pi
(- (angle (vlax-curve-getFirstDeriv e i1) '(0 0))
(angle '(0 0) (vlax-curve-getFirstDeriv e i2))
)
)
(+ pi pi)
)
)
(f e (1- i1) i1)
)
)
)
-
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m )
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel))))))
(setq l
(mapcar '(lambda ( p1 p2 p3 ) (LM:GetLeftAngle p1 p2 p3))
(cons (last l) l) l (append (cdr l) (list (car l)))
)
)
[color=red](mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))[/color]
)
That's a clever line of code!
-
I like your program, I want to shorten it a bit:
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m )
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel))))))
(setq l (mapcar [color=red]'LM:GetLeftAngle[/color] (cons (last l) l) l (append (cdr l) (list (car l)))))
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
Ah yes! Of course - no lambda needed :oops:
Thanks Evgeniy!
as an alternative, I propose a different approach:
Time for more studying :-)
-
That's a clever line of code!
Thanks Roy :-)
-
I really liked the design
(Rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))I will take it on his arms!
Previously, I always use multiple IF...
-
Man you guys are good!
Vovka - with the added function, yours shows the correct angles now.
Lee - yours shows the correct angles.
Evgeniy - yours shows the correct angles only half the time. I think the issue is the same as Vovka's first post, where the polyline direction matters. In the attached drawing, the bottom two polylines should only have one angle of 270, but you code shows the opposite.
I don't even want to show my code now, as the only way I could think of see which angle to get, was to test a point, and see if that was inside the polyline. But I'll show, just don't laugh.
(defun c:Test ( / ActDoc CurSp Sel Data PlObj PtList cnt MaxCnt Ang tempAng Pt tempObj AngList Norm Pt2 tempAng2 )
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq CurSp
(vlax-get
ActDoc
(if (equal (getvar 'CvPort) 1)
'PaperSpace
'ModelSpace
)
)
)
(if
(and
(setq Sel (entsel "\n Select closed polyline: "))
(setq Data (entget (car Sel)))
(= (cdr (assoc 0 Data)) "LWPOLYLINE")
(equal (logand 1 (cdr (assoc 70 Data))) 1)
(setq PlObj (vlax-ename->vla-object (car Sel)))
)
(progn
(foreach i Data
(if (equal (car i) 10)
(setq PtList (cons (cdr i) PtList))
)
)
(setq PtList (reverse PtList))
(setq cnt 0)
(setq MaxCnt (1- (length PtList)))
(while (<= cnt MaxCnt)
(setq Ang
(abs
(-
(setq tempAng
(angle
(setq Pt (nth cnt PtList))
(setq Pt2 (nth (if (zerop cnt) MaxCnt (1- cnt)) PtList))
)
)
(setq tempAng2
(if
(equal
(setq tempAng2
(angle
Pt
(nth (if (equal cnt MaxCnt) 0 (1+ cnt)) PtList)
)
)
0.
)
(* pi 2.)
tempAng2
)
)
)
)
)
(setq Pt (trans Pt (setq Norm (cdr (assoc 210 Data))) 0))
(setq StPt (polar Pt tempAng 0.0001))
(setq tempObj (vlax-invoke CurSp 'AddRay StPt (trans Pt2 Norm 0)))
(vlax-invoke tempObj 'Rotate Pt (* (/ Ang 2.) (if (< tempAng tempAng2) 1. -1.)))
(if
(equal
(rem
(/ (length (vlax-invoke PlObj 'IntersectWith tempObj acExtendNone)) 3)
2
)
1
)
(setq AngList (cons Ang AngList))
(setq AngList (cons (- (* pi 2.) Ang) AngList))
)
;(print (car AngList))
;(getstring "\n Hit enter to continue: ")
(if tempObj (vla-Delete tempObj))
(setq tempObj nil)
(setq cnt (1+ cnt))
)
)
)
(print (mapcar (function RTD) (reverse AngList)))
(princ)
)
Off to study the code posted, so I can test somethings. Thanks for posting guys!!
-
here are some outputs using some of my old stuff:
-
I really liked the design
(Rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))I will take it on his arms!
Previously, I always use multiple IF...
Thanks Evgeniy - that's quite a compliment coming from you! :-)
-
Nice solution Luis. Now I have one more code I need to study when I have time.
-
Just had time to test these today.
The only one that seems to work is Le3's (by looking at pics)
With the example shown, output should only include: ("125" "109" "125" "80" "100")
Testing open and closed polylines...
Vovka's Output (w/o including isboundaryclockwise)
("90" "125" "109" "125" "80" "190") for both
Lee's Output
("90" "125" "109" "125" "80" "10") for both
Elpanov's output
1st code ("90" "125" "109" "125" "80" "10") for both
2nd code
("235" "251" "235" "280" "180" "260") for open polyline
"; error: bad argument type: 2D/3D point: nil" for closed polyline
T.Willey's output
"; error: no function definition: nil" for both
**EDIT**
Was missing the RTD function...output was
("10" "80" "125" "109" "125" "90") for closed
nil (as intended) for open
Using some of the supplied code by Lee and Vovka, this seems to work for both open and closed
(defun GetLeftAngle ( p2 / p1 p3 pos)
(setq pos (vl-position p2 l) p1 (nth (rem (+ n(1- pos)) n) l) p3 (nth (rem (+ n (1+ pos)) n) l))
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m n)
(setq n (length (if (member nil (mapcar '(lambda (x y) (eq x y))
(car (setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel)))))))
(last l))) l (setq l (cdr l))))
l (mapcar 'GetLeftAngle l))
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
*EDIT*
I'm including the example drawing.
-
@ Guitar_Jones:
That is an interesting test but... the polylines you use are "exceptional":
Your open polyline is pseudo-closed. The coordinates of the first and last vertex are identical. A "really" open polyline doesn't have an interior and therefore no interior angles.
Your closed polyline (created from your open polyline) has two vertices with the same coordinates. Your code handles the case where the first and the last vertex are identical, but of course there can be more or other matching sequential vertices.
-
Your open polyline is pseudo-closed. The coordinates of the first and last vertex are identical. A "really" open polyline doesn't have an interior and therefore no interior angles.
I can understand the code not working on the open polylines.
Your closed polyline (created from your open polyline) has two vertices with the same coordinates. Your code handles the case where the first and the last vertex are identical, but of course there can be more or other matching sequential vertices.
IMO, a closed polyline containing matching start/end vertices is not unusual as i found this to be the case in many drawings tested coming from multiple sources.
-
Just had time to test these today.
The only one that seems to work is Le3's (by looking at pics)
With the example shown, output should only include: ("125" "109" "125" "80" "100")
Testing open and closed polylines...
Vovka's Output (w/o including isboundaryclockwise)
("90" "125" "109" "125" "80" "190") for both
Lee's Output
("90" "125" "109" "125" "80" "10") for both
Elpanov's output
1st code ("90" "125" "109" "125" "80" "10") for both
2nd code
("235" "251" "235" "280" "180" "260") for open polyline
"; error: bad argument type: 2D/3D point: nil" for closed polyline
T.Willey's output
"; error: no function definition: nil" for both
**EDIT**
Was missing the RTD function...output was
("10" "80" "125" "109" "125" "90") for closed
nil (as intended) for open
Using some of the supplied code by Lee and Vovka, this seems to work for both open and closed
(defun GetLeftAngle ( p2 / p1 p3 pos)
(setq pos (vl-position p2 l) p1 (nth (rem (+ n(1- pos)) n) l) p3 (nth (rem (+ n (1+ pos)) n) l))
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun c:test ( / l m n)
(setq n (length (if (member nil (mapcar '(lambda (x y) (eq x y))
(car (setq l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel)))))))
(last l))) l (setq l (cdr l))))
l (mapcar 'GetLeftAngle l))
(mapcar 'angtos (if (< (apply '+ l) (apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l)))) l m))
)
*EDIT*
I'm including the example drawing.
So where id the left over degree go ? 539 vs 540 and this is a closed pline ? ya gotta do better.
-
So where id the left over degree go ? 539 vs 540 and this is a closed pline ? ya gotta do better.
The precision of the output angles is based on the auprec variable as the argument is omitted in the code...
-
Maybe just this to avoid duplicate vertices (fuzz could be adjusted):
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
(defun LM:UniqueWithFuzz ( l fz )
(if l (cons (car l) (LM:UniqueWithFuzz (vl-remove-if '(lambda ( x ) (equal x (car l) fz)) (cdr l)) fz)))
)
(defun c:test ( / ss l m )
(if (setq ss (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (70 . 1))))
(progn
(setq l
(LM:UniqueWithFuzz
(mapcar 'cdr (vl-remove-if-not (function (lambda ( x ) (= (car x) 10))) (entget (ssname ss 0))))
1e-8
)
)
(mapcar 'angtos
(if (< (apply '+ (setq l (mapcar 'LM:GetLeftAngle (cons (last l) l) l (append (cdr l) (list (car l))))))
(apply '+ (setq m (mapcar '(lambda ( x ) (- (* 2. pi) x)) l))))
l m
)
)
)
)
)
-
Beautiful. Works perfectly. Thanks Lee!