TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on February 22, 2007, 09:39:58 AM
-
I am in need of some direction. I want to be able to check all lines in a drawing for for accuracy. (i.e. straight versus crooked lines). Please see picture.
Basically I want to be able to run a check on an entire drawing and have it check all lines for accuracy within a given tolerance of say 3 degrees from being straight and once found annotate them with somehow so that the user can go back through the drawing and correct accordingly if needed.
Any assistance is greatly appreciated.
-
Check out this routine.
;;;SNAPLINE.LSP Rectify Lines (c)1998, Galen A. Light
Gary
-
You could always just do the math...http://www.theswamp.org/index.php?topic=5203.0
-
Looks like it would be a fun project for some of the swampers! :-)
-
(vlax-for Lo (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vlax-for Obj (vla-get-Block Lo)
(if
(and
(= (vla-get-ObjectName Obj) "AcDbLine")
(not
(or
(equal (vla-get-Angle Obj) 0.0 0.05)
(equal (vla-get-Angle Obj) (* pi 0.5) 0.05)
(equal (vla-get-Angle Obj) pi 0.05)
(equal (vla-get-Angle Obj) (* pi 1.5) 0.05)
)
)
)
(vla-put-Color Obj 121)
)
)
)
??
-
An example. I have this for for the propoerties of a line...
Command: LIST
Select objects: 1 found
Command: LIST
Select objects: 1 found
Select objects:
LINE Layer: "A-WALL-TENT-EXST"
Space: Model space
Handle = CF05
from point, X=154'-3 1/2" Y=208'-1 1/8" Z= 0'-0"
to point, X=180'-8 3/4" Y=208'-1 1/2" Z= 0'-0"
Length =26'-5 1/4", Angle in XY Plane = 0.06453059
Delta X =26'-5 1/4", Delta Y = 0'-0 3/8", Delta Z = 0'-0
The Angle in the XY plane is off from being "0" by a very small amount. These are the types of lines that I want to be able to search for. In this case it is off by less than a degree.
The supplied code from T.Willey did not catch this line as being incorrect.
-
I am in need of some direction. I want to be able to check all lines in a drawing for for accuracy. (i.e. straight versus crooked lines). Please see picture.
Basically I want to be able to run a check on an entire drawing and have it check all lines for accuracy within a given tolerance of say 3 degrees from being straight and once found annotate them with somehow so that the user can go back through the drawing and correct accordingly if needed.
Any assistance is greatly appreciated.
This is what I went off of. If you want a smaller tolerance, then change these lines in the code.
(or
(equal (vla-get-Angle Obj) 0.0 0.05)
(equal (vla-get-Angle Obj) (* pi 0.5) 0.05)
(equal (vla-get-Angle Obj) pi 0.05)
(equal (vla-get-Angle Obj) (* pi 1.5) 0.05)
)
* don't forget that the angle is in radians. That is how I got the 0.05
Command: (* (/ 3.0 180.0) pi)
0.0523599
-
Try this one ...
(defun c:checklines ( / ss cntr new_ss x y ang ent )
(defun check_angle (ang)
(cond
((= ang (* pi 0.5)) T) ; up
((= ang (* pi 1.0)) T) ; left
((= ang (* pi 1.5)) T) ; down
((= ang 0.0) T) ; zero
)
)
(sssetfirst nil)
(setq ss (ssget "X" '((0 . "LINE")))
cntr 0
new_ss (ssadd)
)
(if (not (zerop (sslength ss)))
(while (setq ent (ssname ss cntr))
(setq x (cdr (assoc 10 (entget ent)))
y (cdr (assoc 11 (entget ent)))
ang (angle x y)
)
(if (not (check_angle ang))
(ssadd ent new_ss)
)
(setq cntr (1+ cntr))
);while
);if
(if (not (zerop (sslength new_ss)))
(sssetfirst nil new_ss)
)
(princ)
)
-
(or
(equal (vla-get-Angle Obj) 0.0 0.05)
(equal (vla-get-Angle Obj) (* pi 0.5) 0.05)
(equal (vla-get-Angle Obj) pi 0.05)
(equal (vla-get-Angle Obj) (* pi 1.5) 0.05)
)
My variant:
((lambda (a) (equal (sin a) (fix (sin a)) (sin (/ pi 60))))
(vla-get-Angle Obj)
)
-
Try this one ...
(defun c:checklines ( / ss cntr new_ss x y ang ent )
(defun check_angle (ang)
(cond
((= ang (* pi 0.5)) T) ; up
((= ang (* pi 1.0)) T) ; left
((= ang (* pi 1.5)) T) ; down
((= ang 0.0) T) ; zero
)
)
(sssetfirst nil)
(setq ss (ssget "X" '((0 . "LINE")))
cntr 0
new_ss (ssadd)
)
(if (not (zerop (sslength ss)))
(while (setq ent (ssname ss cntr))
(setq x (cdr (assoc 10 (entget ent)))
y (cdr (assoc 11 (entget ent)))
ang (angle x y)
)
(if (not (check_angle ang))
(ssadd ent new_ss)
)
(setq cntr (1+ cntr))
);while
);if
(if (not (zerop (sslength new_ss)))
(sssetfirst nil new_ss)
)
(princ)
)
If at check of a corner, it is not necessary to set accuracy (fuzz)
It is enough to check up:
(or
(= (- x1 x2) 0.)
(= (- y1 y2) 0.)
)
For example:
(vl-some
(function equal)
(mapcar (function -)
(cdr (assoc 10 (entget e)))
(cdr (assoc 11 (entget e)))
'(0 0)
) ;_ mapcar
'(0. 0.)
'(1e-8 1e-8)
) ;_ vl-some
-
(or
(equal (vla-get-Angle Obj) 0.0 0.05)
(equal (vla-get-Angle Obj) (* pi 0.5) 0.05)
(equal (vla-get-Angle Obj) pi 0.05)
(equal (vla-get-Angle Obj) (* pi 1.5) 0.05)
)
My variant:
((lambda (a) (equal (sin a) (fix (sin a)) (sin (/ pi 60))))
(vla-get-Angle Obj)
)
You're math skills are better than mine, so I will just assume you are correct. Nice short compact test Evgeniy. :-)
-
((lambda (a) (equal (sin a) (fix (sin a)) (sin (/ pi 60))))
(vla-get-Angle Obj)
)
I think there's a mistake, except if a equals pi/2 or 3pi/2 (fix (sin a)) will always return 0.0.
Example: if a equals pi/120 radians (very closed to 0.0°), it works
_$ (setq a (/ pi 120))
0.0261799
_$ (sin a)
0.0261769
_$ (fix (sin a))
0
_$ (equal (sin a) (fix (sin a)) (sin (/ pi 60)))
T
But, if a is pi/2 + pi/120 radians (very closed to 90.0°), it don't work.
_$ (setq a (+ (/ pi 2) (/ pi 120)))
1.59698
_$ (sin a)
0.999657
_$ (fix (sin a))
0
_$ (equal (sin a) (fix (sin a)) (sin (/ pi 60)))
nil
Evgeniy's code should be right whith '=' or 'eq' functions, but can't be used with 'equal' and a 'fuzz'.
-
Another version, less compact, but semms to work
((lambda (a)
(or
(equal (sin a) 0.0 0.05)
(equal (abs (sin a)) 1.0 0.05)
)
)
(vla-get-Angle Obj)
)
-
Thanks for all of the responses. Great work. All of the posted code seems to find all lines that are greatly at an angle but not find others that are off just so slightly.
-
((lambda (a) (equal (sin a) (fix (sin a)) (sin (/ pi 60))))
(vla-get-Angle Obj)
)
I think there's a mistake, except if a equals pi/2 or 3pi/2 (fix (sin a)) will always return 0.0.
Example: if a equals pi/120 radians (very closed to 0.0°), it works
_$ (setq a (/ pi 120))
0.0261799
_$ (sin a)
0.0261769
_$ (fix (sin a))
0
_$ (equal (sin a) (fix (sin a)) (sin (/ pi 60)))
T
But, if a is pi/2 + pi/120 radians (very closed to 90.0°), it don't work.
_$ (setq a (+ (/ pi 2) (/ pi 120)))
1.59698
_$ (sin a)
0.999657
_$ (fix (sin a))
0
_$ (equal (sin a) (fix (sin a)) (sin (/ pi 60)))
nil
Evgeniy's code should be right whith '=' or 'eq' functions, but can't be used with 'equal' and a 'fuzz'.
I am sorry! :oops:
I have hastened and have badly expressed the idea...
Many thanks gile! You have corrected me.
In my example, it is necessary to use
(fix (+ (sin a) 0.5))
Then all example will look:
((lambda (a) (equal (sin a) (fix (+(sin a)0.5)) (sin (/ pi 60))))
(vla-get-Angle Obj)
)
-
Thanks for all of the responses. Great work. All of the posted code seems to find all lines that are greatly at an angle but not find others that are off just so slightly.
Did you change the my code as I noted? If so, then it still doesn't grab all the lines?
-
Did you change the my code as I noted? If so, then it still doesn't grab all the lines?
I used the following code.
(vlax-for Lo (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vlax-for Obj (vla-get-Block Lo)
(if
(and
(= (vla-get-ObjectName Obj) "AcDbLine")
(not
(or
((lambda (a)
(or
(equal (sin a) 0.0 0.02)
(equal (abs (sin a)) 1.0 0.02)
)
)
(vla-get-Angle Obj)
)
)
)
)
(vla-put-Color Obj 221)
)
)
)
-
You are still allowing for a tolerance of 1.14592 degrees. If you want a very small number, then change this
(or
(equal (sin a) 0.0 0.02)
(equal (abs (sin a)) 1.0 0.02)
)
to
(or
(equal (sin a) 0.0 0.0000001)
(equal (abs (sin a)) 1.0 0.0000001)
)
This will get all lines that are not at a right angle.
-
Evgeniy,
There's still a problem with your new code, if (sin a) is closed to -1.
((lambda (a) (equal (sin a) (fix (+ (sin a) 0.5)) (sin (/ pi 60))))
(+ (* pi 1.5) (/ pi 90))
)
Should return T, but return nil.
Maybe replace 'fix' function by a 'round' function working with negative numbers.
(defun round (num)
(if (minusp num)
(fix (- num 0.5))
(fix (+ num 0.5))
)
)
-
You are still allowing for a tolerance of 1.14592 degrees. If you want a very small number, then change this
Code:
(or
(equal (sin a) 0.0 0.02)
(equal (abs (sin a)) 1.0 0.02)
)
to
Code:
(or
(equal (sin a) 0.0 0.0000001)
(equal (abs (sin a)) 1.0 0.0000001)
)
Thanks T.Willey That was the problem. Works like a dream.
-
You are still allowing for a tolerance of 1.14592 degrees. If you want a very small number, then change this
Code:
(or
(equal (sin a) 0.0 0.02)
(equal (abs (sin a)) 1.0 0.02)
)
to
Code:
(or
(equal (sin a) 0.0 0.0000001)
(equal (abs (sin a)) 1.0 0.0000001)
)
Thanks T.Willey That was the problem. Works like a dream.
You're welcome. You might want to change the code back the the first one I posted, with making the same changes to it. It seems like a debate aboutt he math of the code you are using.
-
Thanks for all of the responses. Great work. All of the posted code seems to find all lines that are greatly at an angle but not find others that are off just so slightly.
Mine does! :-)
-
Evgeniy,
There's still a problem with your new code, if (sin a) is closed to -1.
((lambda (a) (equal (sin a) (fix (+ (sin a) 0.5)) (sin (/ pi 60))))
(+ (* pi 1.5) (/ pi 90))
)
Should return T, but return nil.
Maybe replace 'fix' function by a 'round' function working with negative numbers.
(defun round (num)
(if (minusp num)
(fix (- num 0.5))
(fix (+ num 0.5))
)
)
Once again I apologize, for the carelessness...
In Russia today a holiday and not the working day.
Now we with family celebrate.
Thanks gile for the instruction of mistakes!
New variant...
(equal (abs(sin a)) (fix (+ (abs(sin a)) 0.5)) (sin (/ pi 60)))
-
Check out this routine.
;;;SNAPLINE.LSP Rectify Lines (c)1998, Galen A. Light
Gary
You should check out the routine above, you can enter a fudge factor, and it will fix the line.
To Rectify Lines that are not truely Horizontal or Vertical.
(prompt "\n* Change angled Line to a 0 or 90 setting *")
(setq dvar (abs (getreal "\n* Enter degrees of variance: *")))
Gary
-
:oops: :|
I'm sorry, none code posted by Evgeniy and I are realy exact.
Comparing only the angle sinus to 0 or 1 is not rigorous.
I'm going to try an explaination. If a equals pi/60 radians (3°) and b equals pi/2 + pi/60 (93°)
sinus a is equal to 0.052336
sinus b is equal to 0.99863
The codes posted by Evgeniy and I were comparing as well sinus a to 0 and sinus b to 1 and the result isn't the same even there's in both case the same rotation from 0° and 90°. The comparation isn't the same for 'horizontal' or 'vertical' angles.
I think it have been more rigorous to compare sinus a and cosinus b both to 0 (as sinus a, cosinus b is equal to -0.052336)
So, if we want to use trigonometry, instead of :
(or
(equal (vla-get-Angle Obj) 0.0 0.05)
(equal (vla-get-Angle Obj) (* pi 0.5) 0.05)
(equal (vla-get-Angle Obj) pi 0.05)
(equal (vla-get-Angle Obj) (* pi 1.5) 0.05)
)
the good algorithm should be :
((lambda (a)
(or
(equal (sin a) 0.0 0.05)
(equal (cos a) 0.0 0.05)
)
)
(vla-get-Angle Obj)
)
-
Thanks Gile. I was going to try and understand what you two have been posting when I got some time. My trig sucks really bad right now, so it will take a while for me to understand it.
-
My trig sucks really bad right now, so it will take a while for me to understand it.
It's not very difficult to understand.
In my opinion the simplest way to understand/remeber trigonometry is using the 'trigonometric circle'.
A circle which radius is equal to 1, with two axis : cosinus axis (horizontal) and sinus axis (vertical).
In this circle angles are increasing conterclockwise from 0 (East).
The projection of each angle line on cosinus axis is the cos value as well for sinus.
So :
cos 0° = 1 and sin 0° = 0
cos 90° = 0 and sin 90° = 1
cos 1800° = -1 and sin 180° = 0
cos 270° = 0 and sin 270° = -1
(http://xs412.xs.to/xs412/07085/trig.png)
-
Summed up, at me it has turned out four programs...
Check of a corner of a line, without taking into account fuzz.
function use vla-object.
(defun test-not-orto (/ ss)
;; use vla-object
(if (setq ss (ssget '((0 . "LINE"))))
(foreach e (mapcar (function vlax-ename->vla-object)
(vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
) ;_ mapcar
(if (not (vl-some (function equal) (vlax-curve-getFirstDeriv e 0.) '(0. 0.) '(1e-8 1e-8)))
(vla-put-Color e 1)
) ;_ if
) ;_ foreach
) ;_ if
(princ)
) ;_ defun
Check of a corner of a line, without taking into account fuzz.
function not use vla-object.
(defun test-not-orto (/ ss)
;; not use vla-object
(if (setq ss (ssget '((0 . "LINE"))))
(foreach e (mapcar (function entget) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))))
(if (not (vl-some (function equal)
(mapcar (function -) (cdr (assoc 10 e)) (cdr (assoc 11 e)) '(0 0))
'(0. 0.)
'(1e-8 1e-8)
) ;_ vl-some
) ;_ not
(entmod
(if (assoc 62 e)
(subst '(62 . 1) (assoc 62 e) e)
(append (reverse (cons '(62 . 1) (vl-member-if (function (lambda (x) (= (car x) 8))) (reverse e))))
(cdr (vl-member-if (function (lambda (x) (= (car x) 8))) e))
) ;_ append
) ;_ if
) ;_ entmod
) ;_ if
) ;_ foreach
) ;_ if
(princ)
) ;_ defun
Check of a corner of a line, taking into account fuzz.
function use vla-object.
(defun test-not-orto-fuzz (/ ss)
;; use vla-object
(if (setq ss (ssget '((0 . "LINE"))))
(foreach e (mapcar (function vlax-ename->vla-object)
(vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
) ;_ mapcar
(if (not ((lambda (a) (or (equal (sin a) 0.0 0.05) (equal (cos a) 0.0 0.05))) (vla-get-Angle e)))
(vla-put-Color e 1)
) ;_ if
) ;_ foreach
) ;_ if
(princ)
) ;_ defun
Check of a corner of a line, taking into account fuzz.
function not use vla-object.
(defun test-not-orto-fuzz (/ ss)
;; not use vla-object
(if (setq ss (ssget '((0 . "LINE"))))
(foreach e (mapcar (function entget) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))))
(if (not ((lambda (a) (or (equal (sin a) 0.0 0.05) (equal (cos a) 0.0 0.05)))
(angle (cdr (assoc 10 e)) (cdr (assoc 11 e)))
)
) ;_ not
(entmod
(if (assoc 62 e)
(subst '(62 . 1) (assoc 62 e) e)
(append (reverse (cons '(62 . 1) (vl-member-if (function (lambda (x) (= (car x) 8))) (reverse e))))
(cdr (vl-member-if (function (lambda (x) (= (car x) 8))) e))
) ;_ append
) ;_ if
) ;_ entmod
) ;_ if
) ;_ foreach
) ;_ if
(princ)
) ;_ defun
-
:oops: :|
the good algorithm should be :
((lambda (a)
(or
(equal (sin a) 0.0 0.05)
(equal (cos a) 0.0 0.05)
)
)
(vla-get-Angle Obj)
)
how about this solution? :-) a little faster
because SIN(2*A)=2*SIN(A)*COS(A)
((LAMBDA (a)
(EQUAL (sin (+ a a) 0.0 0.104528))
)
(vla-get-Angle Obj)
)
-
Welcome to the swamp fools
Nice lisp, although there is a miss-placed parentheses in your post
((lambda (a)
(equal (sin (+ a a)[color=red])[/color] 0.0 0.0523599) ; +-3 deg
)
(vla-get-angle Obj)
)
-
OK, I'm having a problem with this angle:
a = 6.25215 or 358.222 deg
_1_$ (sin (+ a a))
-0.0620258
_1_$ (rtod (sin (+ a a)))
-3.55382
_1_$ (- (* 2 pi) a)
0.0310328
-
Welcome to the swamp fools
Nice lisp, although there is a miss-placed parentheses in your post
((lambda (a)
(equal (sin (+ a a)[color=red])[/color] 0.0 0.0523599) ; +-3 deg
)
(vla-get-angle Obj)
)
Thanks CAB for your greeting. And thanks u again for pointing out my mistake. :-)
In my function , +-3 deg is double. (sin (/ pi 30))=0.104528 , not 0.0523599.
other angles :
(mapcar (function (lambda (x) (sin (/ (* 2 PI x) 180)))) '(3 87 93 177 183 267 273 357))
;;return (0.104528 0.104528 -0.104528 -0.104528 0.104528 0.104528 -0.104528 -0.104528)
So the code is
((LAMBDA (a)
(EQUAL (SIN (+ a a)) 0.0 0.104528) ; +-3 deg
)(VLA-GET-ANGLE Obj)
)
-
You'er quite right. Too much math for me. :-)
I did find my mistake though, using my test rig.
(defun c:test2()
(mapcar '(lambda (a / b)
(setq b (print (rtod a)))
(print a)
(print (sin (+ a a)))
(print (equal (sin (+ a a)) 0.0 0.104528)) ; +-3 deg
(print)
)
(mapcar 'dtor '(2 2.9 3 87 87.9 92 92.9 94 176 176.9 177 182 182.9 183 267 267.9 268 272 272.9 273 357 357.9 359))
)
(princ)
)
PS, yes the "Double" got me. :oops:
-
how about this solution? :-) a little faster
because SIN(2*A)=2*SIN(A)*COS(A)
((LAMBDA (a)
(EQUAL (sin (+ a a) 0.0 0.104528))
)
(vla-get-Angle Obj)
)
Thank you, fools :-)
Realy nice one, I like it, indeed.