TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Joe Burke on May 20, 2008, 12:16:36 PM

Think about this.
Group: autodesk.autocad.customization Tony Tanzillo <tony.tanzi...@worldnet.att.net> wrote in article <3664CFB1.
93B45...@worldnet.att.net>... Bob  This isn't remotely close to what he needs.
AutoCAD can't find the minimum clearance between two objects as Microstation can.
I think Tony is wrong about this. I wrote an alorithm which works in most cases for any two curve objects. The function is about eight lines of code. Can you guess how it works?

The only way I can think of doing it is by stepping points on one object and using vlaxcurvegetclosestpointto to the other object. Then store the two points and distance in a list then sort the list by shortest distance :?
How'd you do it Joe?

to use vlaxcurvegetclosestpointto on arcs one will have to build an approximation and that is not 100% accurate

Think about this.
Group: autodesk.autocad.customization Tony Tanzillo <tony.tanzi...@worldnet.att.net> wrote in article <3664CFB1.
93B45...@worldnet.att.net>... Bob  This isn't remotely close to what he needs.
AutoCAD can't find the minimum clearance between two objects as Microstation can.
I think Tony is wrong about this. I wrote an alorithm which works in most cases for any two curve objects. The function is about eight lines of code. Can you guess how it works?
Joe, I haven't seen the thread, but was the reference to the OutOfTheBox application. ?

Kerry,
I don't have time for a full reply now.
I'll just say I think Tony meant vanilla AutoCAD. Does some vertical app have a minimum distance tool?
More later...

...minimum clearance...
ADT can for stair openings, so why wouldn't other apps be able to?

I thought I posted this, but later I don't see it.
Here's some beta code which demonstrates the idea. It should work in the vast majority of typical cases. I'm aware there are a few odd cases where it will not. I'm working on those. See inline comments.
Comments and suggestions welcome.

to use vlaxcurvegetclosestpointto on arcs one will have to build an approximation and that is not 100% accurate
Given there's no such thing as 100% accurate within AutoCAD, try the code I posted.
It uses an approximation method for all supported object types because one subroutine can process all object types. IOW, a lot less code than would be needed if the line to line condition used a specific subroutine. Which is possible.

The only way I can think of doing it is by stepping points on one object and using vlaxcurvegetclosestpointto to the other object. Then store the two points and distance in a list then sort the list by shortest distance :?
How'd you do it Joe?
Something like that, but without using vlsort. See the MD:ObjObj subfunction in the code I posted.

Here's my "ghettofied" solution... :D
(defun rjpgetmindistof2curveobjs
(div / inc len lst n obj1 obj2 pt1 pt2)
(if (and (setq obj1 (car (entsel "\nSelect first curve object: ")))
(setq obj2 (car (entsel "\nSelect second curve object: ")))
)
(progn
(setq len (vlaxcurvegetdistatparam
obj1
(vlaxcurvegetendparam obj1)
)
n 0.0
inc (/ len div)
)
(repeat div
(setq pt1 (vlaxcurvegetpointatdist obj1 n)
pt2 (vlaxcurvegetclosestpointto obj2 pt1)
n (+ inc n)
lst (cons (list (distance pt1 pt2) pt1 pt2) lst)
)
)
(setq lst (vlsort lst
(function (lambda (d1 d2)
(< (car d1) (car d2))
)
)
)
lst (car lst)
)
(grdraw (cadr lst) (caddr lst) 1)
lst
)
)
)
(rjpgetmindistof2curveobjs 1000)
*removed line creation and added vector

Here is my first try. :)

Here is my first try. :)
Hi Alan,
I haven't tried your code, but it looks right.
As I said to ronjonp, there's really no reason to make a list of distances and then use the min or the vlsort function.
And I think setting step to (/ len 1000) is total overkill. You don't need that many iterations if your code works like mine.
Regards
Joe

Here is my first try. :)
And I think setting step to (/ len 1000) is total overkill...
Regards
Joe
Depends on the length of the items tested...if the lines are 10000 ft long then the check is only every 10 feet :P

Here is my first try. :)
And I think setting step to (/ len 1000) is total overkill...
Regards
Joe
Depends on the length of the items tested...if the lines are 10000 ft long then the check is only every 10 feet :P
Not correct. The length of the objects involved is not an issue. Study my code.

to use vlaxcurvegetclosestpointto on arcs one will have to build an approximation and that is not 100% accurate
Given there's no such thing as 100% accurate within AutoCAD, try the code I posted.
my reply concerned Ron's suggestiong, but your tricky approach is a wow :)

Here is my first try. :)
And I think setting step to (/ len 1000) is total overkill...
Regards
Joe
Depends on the length of the items tested...if the lines are 10000 ft long then the check is only every 10 feet :P
Not correct. The length of the objects involved is not an issue. Study my code.
Joe,
I was referring to my code...I tried your code but got different results depending on where my pick points were (but there's been one or more times where I don't understand what's going on) :D

it's my try Joe
sometimes 5 repetitions are enough and sometimes 30 are not
let the code itself decide when it is enough :)
(defun MD:ObjObj (obj1 obj2 pt / p d fuzz)
(setq fuzz 1E8)
(while (not
(equal (distance pt (setq p (vlaxcurveGetClosestPointTo obj2 pt)))
(setq d (distance p (setq pt (vlaxcurveGetClosestPointTo obj1 p))))
fuzz
)
)
)
(list d pt p)
)

Here is an example of a difficult situation.
My code will work if one of the ellipses is selected as indicated. I don't mean to imply this is a good solution. It's just something I'm working on...

it's my try Joe
sometimes 5 repetitions are enough and sometimes 30 are not
let the code itself decide when it is enough :)
(defun MD:ObjObj (obj1 obj2 pt / p d fuzz)
(setq fuzz 1E8)
(while
(progn (setq pd)
(not
(equal (setq d (distance p (setq pt (vlaxcurveGetClosestPointTo obj1 p))))
(distance pt (setq p (vlaxcurveGetClosestPointTo obj2 pt)))
fuzz
)
)
)
)
(list d pt p)
)
That makes sense :)

i've made some changes to my code, sorry for stupid errors :)

Joe,
There is a problem with this scenario.

one more situation

No need to sort since you're only looking for one point, right?
(defun c:getshortdist ( / shortdist osm col ent1 ent2 step iter ent1cp ent2cp clist)
(setq osm (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(setq ent1 (car (entsel "\nSelect first curve: ")))
(setq ent2 (car (entsel "\nSelect second curve: ")))
;(setq step (getreal "\nEnter step value: "))
(setq step 0.1)
(setq iter step)
(while (vlaxcurvegetPointAtDist ent1 iter)
(setq ent1cp (vlaxcurvegetPointAtDist ent1 iter))
(setq ent2cp (vlaxcurvegetClosestPointTo ent2 ent1cp))
(setq cpdist (distance ent1cp ent2cp))
(setq clist (list cpdist ent1cp ent2cp))
(if (or (= shortdist nil) (< (car clist) (car shortdist))) (setq shortdist clist))
(setq iter (+ iter step))
)
(setvar "cecolor" "210")
(command "_line" (cadr shortdist) (caddr shortdist) "")
(command "point" (cadr shortdist))
(command "point" (caddr shortdist))
(setvar "cecolor" col)
(setvar "osmode" osm)
)

Thanks to all who replied.
I'll study the posted code and see what can be done to fix the problems.

And I think setting step to (/ len 1000) is total overkill...
Regards
Joe
Depends on the length of the items tested...if the lines are 10000 ft long then the check is only every 10 feet :P
I work in inch units so my typical worst case would be site work with a 250' lot line. In this
case the 3000 inch plines would mean a check every 3 inches. The 1000 is reasonably fast
on my machine in ACAD2000. So that is what I used as well. The alternative is more code.
In fact it would need some intelligent code. For plines the check would need to be at and
midway between each vertex. That would catch a bulge. For circles, ellipses & arcs you
could check using a "Bracket" algorithm. So I think you get my drift.

Joe,
I really like your shortest distance feed back code.

To all who replied.
The problems VovKa pointed out were essentially the ones I was aware of as noted in my first code post. At first glance they seemed hard to solve. But after some thinking, it seems not.
Attached is beta version 2. I hope it solves those problems without much additional code/overhead.
Please let me know if you find a case where it does not work as expected.
BTW, there are some bells and whistes I intend to add. The main one is report when two lines or rays or xlines are parallel. There should also be testing for coplanar objects.
Regards and thanks...

Joe,
I really like your shortest distance feed back code.
Thanks, Alan. The idea behind it is you don't have to check for points along the entire length of each object.

more AI should be employed

This is my version 2. Added grdraw
;; CAB @ TheSwamp.org  5/22/2008
;; Version 2
;; Returns the minimum distance between two objects.
;; Supported object types: any vlaxcurve object
;;
(defun c:MD() (c:MinDist))
(defun c:MinDist (/ step e1 e2 p1 p2 len idx dis dlst
curveOK getent)
(vlloadcom)
;; CAB test to see if vlaxcurve can be used on an object
(defun curveOK (ent) ; returns nil if not allowed
(not (vlcatchallerrorp
(vlcatchallapply 'vlaxcurvegetendparam (list ent))
)
)
)
;; returns an entity which can be used with vlaxcurve
(defun getent (pmt / ent)
(while (not (and (setq ent (car (entsel pmt)))
(curveOK ent)
))
(prompt "\nMissed or not a Curve object. Try again.")
)
ent
)
;;=========================================================
(setq e1 (getent "\nFirst entity."))
(setq e2 (getent "\nSecond entity."))
(setq len (vlaxcurvegetdistatparam e1 (vlaxcurvegetendparam e1)))
(setq idx 0.0
step (/ len 1000)
)
(cond
((vlaxinvoke
(vlaxename>vlaobject e1) 'IntersectWith
(vlaxename>vlaobject e2) acExtendNone)
(setq dis 0.0)
)
(t
(while (and (<= idx len)
(setq p1 (vlaxcurvegetpointatdist e1 idx))
(setq p2 (vlaxcurvegetclosestpointto e2 p1))
)
(setq dis (distance p1 p2)
idx (+ idx step)
)
(if (or (null dlst) (< dis (car dlst)))
(setq dlst (list dis p1 p2))
)
)
(if (and dlst (listp dlst))
(grdraw (trans (cadr dlst)0 1)(trans (caddr dlst)0 1) 6 1)
)
)
)
(print dis)
(princ)
)
(prompt "\nMinimum Distance Loaded, Enter MD to run.")
(princ)

the weakest link in Alan's code is (setq step (/ len 1000)), to eleminate this i suggest stealing Joe's idea like this:
(defun 2ObjDist (obj1 obj2 pt / p d fuzz)
(setq fuzz 1E8)
(while (not
(minusp
( (distance pt (setq p (vlaxcurveGetClosestPointTo obj2 pt)))
(setq d (distance p (setq pt (vlaxcurveGetClosestPointTo obj1 p))))
fuzz
)
)
)
)
(list d pt p)
)
and placing it...
(t
(while (and (<= idx len)
(setq p1 (vlaxcurvegetpointatdist e1 idx))
(setq p2 (vlaxcurvegetclosestpointto e2 p1))
)
(setq dis (distance p1 p2)
idx (+ idx step)
)
(if (or (null dlst) (< dis (car dlst)))
(setq dlst (list dis p1 p2))
)
)
(setq dlst (2ObjDist e1 e2 (cadr dlst)));< right here
(if (and dlst (listp dlst))
(grdraw (trans (cadr dlst)0 1)(trans (caddr dlst)0 1) 6 1)
)
)

This is my version 2. Added grdraw
Alan,
I noticed a minor problem with your code. I'd suggest this change at the end.
; (print dis)
(print (car dlst))
While testing with two full ellipses I found it would return the right answer only if I picked the objects in a certain order. In the opposite order the answer was very different.

more AI should be employed
VovKa,
Thanks for the example. Agreed, my latest code doesn't fix that one.

the weakest link in Alan's code is (setq step (/ len 1000)), to eleminate this i suggest stealing Joe's idea like this:
VovKa,
I tried your function within Alan's code. Given the two ellipses example, I see a 5% increase in accuracy.
Thank you for your keen insights into the issues involved.
I think I'm going to have to do something similar to Alan's approach to ensure the correct point is passed to the function which sharpens accuracy with irregular curves like splines and ellipses.

OK here is version 3 with the 2ObjDist subroutine.
Great subroutine by the way. Who get the credit for it? 8)
;; CAB @ TheSwamp.org  5/23/2008
;; Version 3
;; Returns the minimum distance between two objects.
;; Supported object types: any vlaxcurve object
;;
(defun c:MD() (c:MinDist))
(defun c:MinDist (/ step e1 e2 p1 p2 len idx dis dlst
curveOK getent)
(vlloadcom)
;; CAB test to see if vlaxcurve can be used on an object
(defun curveOK (ent) ; returns nil if not allowed
(not (vlcatchallerrorp
(vlcatchallapply 'vlaxcurvegetendparam (list ent))
)
)
)
;; returns an entity which can be used with vlaxcurve
(defun getent (pmt / ent)
(while (not (and (setq ent (car (entsel pmt)))
(curveOK ent)
))
(prompt "\nMissed or not a Curve object. Try again.")
)
ent
)
;; get the min distance between 2 objects nearest to pt
;; pt should be a point on obj1
(defun 2ObjDist (obj1 obj2 pt / p d fuzz)
(setq fuzz 1E8)
(while (not
(minusp
( (distance pt (setq p (vlaxcurveGetClosestPointTo obj2 pt)))
(setq d (distance p (setq pt (vlaxcurveGetClosestPointTo obj1 p))))
fuzz
)
)
)
)
(list d pt p)
)
;;=========================================================
(setq e1 (getent "\nFirst entity."))
(setq e2 (getent "\nSecond entity."))
(setq len (vlaxcurvegetdistatparam e1 (vlaxcurvegetendparam e1)))
(setq idx 0.0
step (/ len 100) ; 100 may need to increase for very large unit objects
)
(cond
((vlaxinvoke
(vlaxename>vlaobject e1) 'IntersectWith
(vlaxename>vlaobject e2) acExtendNone)
(setq dis 0.0)
)
(t ; find the min distance within the steps. The accuracy is limited by the
;; number of steps, then 2ObjDist is used to increase the accuracy
(while (and (<= idx len)
(setq p1 (vlaxcurvegetpointatdist e1 idx))
(setq p2 (vlaxcurvegetclosestpointto e2 p1))
)
(setq dis (distance p1 p2)
idx (+ idx step)
)
(if (or (null dlst) (< dis (car dlst)))
(setq dlst (list dis p1 p2))
)
)
(if (and dlst (listp dlst))
(progn
(setq dlst (2ObjDist e1 e2 (cadr dlst))
dis (car dlst))
(grdraw (trans (cadr dlst)0 1)(trans (caddr dlst)0 1) 6 1)
)
)
)
)
(print dis)
(princ)
)
(prompt "\nMinimum Distance Loaded, Enter MD to run.")
(princ)

Alan i added some things to your code, hope you don't mind :)
(defun c:MinDist (/ step e1 e2 p1 p2 len idx dis dlst curveOK getent hasb e3)
(vlloadcom)
;; CAB test to see if vlaxcurve can be used on an object
(defun curveOK (ent) ; returns nil if not allowed
(not (vlcatchallerrorp
(vlcatchallapply 'vlaxcurvegetendparam (list ent))
)
)
)
;; returns an entity which can be used with vlaxcurve
(defun getent (pmt / ent)
(while (not (and (setq ent (car (entsel pmt))) (curveOK ent)))
(prompt "\nMissed or not a Curve object. Try again.")
)
ent
)
;; get the min distance between 2 objects nearest to pt
;; pt should be a point on obj1
(defun 2ObjDist (e1 e2 p1 / p2 d fuzz)
(setq fuzz 1E8)
(while (not
(minusp
( (distance p1 (setq p2 (vlaxcurveGetClosestPointTo e2 p1)))
(setq d (distance p2 (setq p1 (vlaxcurveGetClosestPointTo e1 p2))))
fuzz
)
)
)
)
(list d p1 p2)
)
(defun NoBulgeDist (e1 e2 / p1 p2 i d)
(setq i (vlaxcurvegetEndParam e1))
(while (and (>= i 0))
(setq p2 (vlaxcurvegetClosestPointTo
e2
(setq p1 (vlaxcurvegetPointAtParam e1 i))
)
hasb (or hasb (not (equal (vlaxcurvegetSecondDeriv e1 i) '(0 0 0))))
i (1 i)
d (distance p1 p2)
dlst (if (or (< d (car dlst)) (null dlst))
(list d p1 p2)
dlst
)
)
)
)
;;=========================================================
(setq e1 (getent "\nFirst entity: "))
(setq e2 (getent "\nSecond entity: "))
(if (vlaxinvoke
(vlaxename>vlaobject e1)
'IntersectWith
(vlaxename>vlaobject e2)
acExtendNone
)
(setq dis 0.0)
(progn (NoBulgeDist e2 e1)
(setq dlst (cons (car dlst) (reverse (cdr dlst))))
(NoBulgeDist e1 e2)
(if hasb
(progn (if (> (vlaxcurvegetDistAtParam e1 (vlaxcurvegetEndParam e1))
(vlaxcurvegetDistAtParam e2 (vlaxcurvegetEndParam e2))
)
(setq e3 e1
e1 e2
e2 e3
dlst (cons (car dlst) (reverse (cdr dlst)))
)
)
; find the min distance within the steps. The accuracy is limited by the
number of steps, then 2ObjDist is used to increase the accuracy;
(setq idx 0.0
len (vlaxcurvegetdistatparam e1 (vlaxcurvegetendparam e1))
step (/ len 1000) ; 100 may need to increase for very large unit objects
)
(while (and (<= idx len) (setq p1 (vlaxcurvegetpointatdist e1 idx)))
(setq p2 (vlaxcurvegetclosestpointto e2 p1)
dis (distance p1 p2)
idx (+ idx step)
)
(if (< dis (car dlst))
(setq dlst (list dis p1 p2))
)
)
)
)
(setq dlst (2ObjDist e1 e2 (cadr dlst)))
(setq dis (car dlst))
(grdraw (trans (cadr dlst) 0 1) (trans (caddr dlst) 0 1) 6 1)
)
)
(print dis)
(princ)
)

My bells and whistles version attached. Check the header comments.
With thanks to Alan and VovKa. :)

Here is my contribution...will prompt if objects except *polylines (no time right now to address) are parallel.
...
;;Adds distances gathered into dlst then divides by (1+ div)
;;to check if equal (+ 0.001) to middle item in list. Still need to
;;create function to account for polylines as well
(if (and (equal on1 on2)
(not (wcmatch on1 "*Polyline"))
(not (wcmatch on2 "*Polyline"))
(equal (/ (apply '+ dlst) (1+ div))
(nth (/ (length dlst) 2) dlst)
0.001
)
)
(setq m (strcat "\n(" (substr on1 5) "'s appear to be parallel)"))
(setq m "")
)
...
Ron

hi Joe
may i suggest 2 things that you've missed in my last post :pissed: :)
http://www.theswamp.org/index.php?topic=23170.msg280044#msg280044 (http://www.theswamp.org/index.php?topic=23170.msg280044#msg280044)
if two polylines are selected it would be better to run NoBulgeDist on them, and if they do not have bulges we will have the desired distance right away (much faster)
we will get the desired distance faster if we step along the shortest of two selected objects

Hi VovKa,
I ran speed tests while working on the latest code. They indicated the
core part of the routine, from IntersectWith to where the two points are
known, was already fast. Like 0.1 second or less and often half that.
This includes cases where the second calculation, the part you rewrote,
gets a good workout.
At that point I thought, rightly or wrongly, trying to make it faster
wasn't worth it. I'm sure you're right, it could be faster. I wonder
though whether the user would ever see the difference.
There could be a condition which tests for whether either objects is a
circle. Special case since there are no ends to deal with. Get the closest
point on the other object from center point of the circle. Get the closest
point on the circle from that point.
I found something interesting while speed testing. Check the attached
example file and the test routine which follows. The polylines have more
than 600 vertices, no bulges I believe. The IntersectWith method takes
about 0.35 second to compare the objects. It causes a noticeable lag in
the routine.
(defun StartTimer ()
(setq *start* (getvar "date")))
(defun EndTimer (/ end)
(setq end (* 86400 ( (getvar "date") *start*)))
(princ (strcat "\nTimer: " (rtos end 2 8) " seconds\n")))
(defun c:test ( / obj1 obj2)
(setq obj1 (car (entsel "\nSelect polyline: "))
obj1 (vlaxename>vlaobject obj1)
obj2 (car (entsel "\nSelect polyline: "))
obj2 (vlaxename>vlaobject obj2)
)
(starttimer)
(vlaxinvoke obj1 'IntersectWith obj2 acExtendNone)
(endtimer)
)

we will get the desired distance faster if we step along the shortest of two selected objects
Do you mean faster because the test points along the shorter object are spaced closer together? And that may mean fewer iterations during the second calculation?

Here is my contribution...will prompt if objects except *polylines (no time right now to address) are parallel.
Interesting idea. It would be nice to eliminate these two subfunctions, MD:NormalAngle and MD:ParallelLines, which only serve a limited purpose.

Do you mean faster because the test points along the shorter object are spaced closer together? And that may mean fewer iterations during the second calculation?
i think in most cases it will be true
as for IntersectWith... it's doing 645*621 (inters)es, or whatever it's programmed to do, maybe it has to be slow :)

Here is my contribution...will prompt if objects except *polylines (no time right now to address) are parallel.
Interesting idea. It would be nice to eliminate these two subfunctions, MD:NormalAngle and MD:ParallelLines, which only serve a limited purpose.
Done....I also changed the code a bit to compare the averaged distance to the midpoint distance. My previous function would fail if one object was longer than the other.

Done....I also changed the code a bit to compare the averaged distance to the midpoint distance. My previous function would fail if one object was longer than the other.
I'm confused. Did you update the code posted before, or did you intend to post a new version?

I added the following condition before the T condition. It uses the center of a circle as test point if one of the two objects is a circle.
AFAIK it's reliable and as expected it reduces the core function elapsed time to zero. On average it saves about 0.05 second. Obviously not worth the effort.
At the risk of repeating myself, though one method may prove faster than another, that does not always translate to a meaningful improvement. I would leave the code as is.
((setq pos (vlposition "AcDbCircle" (list typ1 typ2)))
(if (zerop pos)
(setq testpt (vlaxget obj1 'Center))
(setq testpt (vlaxget obj2 'Center))
)
(if (not (zerop pos))
;; Reverse the objects.
(setq temp obj1 obj1 obj2 obj2 temp)
)
(setq p1 (vlaxcurveGetClosestPointTo obj2 testpt)
pt (vlaxcurveGetClosestPointTo obj1 p1)
d (distance pt p1)
resdist d
)
)
One other thought. If anyone wants to post a new version it should be labeled as beta until others have a chance to test it.
Regards
Joe

Done....I also changed the code a bit to compare the averaged distance to the midpoint distance. My previous function would fail if one object was longer than the other.
I'm confused. Did you update the code posted before, or did you intend to post a new version?
I updated the code here:
http://www.theswamp.org/index.php?topic=23170.msg280827#msg280827

I tried your code. Sorry, but I doubt it will work.
Attached is an example. When I run your code and select the two lines it reprorts they are parallel, when obviously they are not.
This appoach is a deadend because parallel is essentially an angular function. Trying to compare points to determine parallel is full of pitfalls.

who cares about paralellness? :)
we are looking for minimum distance ie. two closest points... imho

who cares about paralellness? :)
we are looking for minimum distance ie. two closest points... imho
I care because there were two driving forces behind the idea. The first one was godzilla Tony saying it can't be done. And the second one was a practical application of the idea which may not be readily apparent.
I'm often given CAD files drawn by someone other than myself. I want a quick way to check accuracy. For example, a structural grid file which is already dimensioned. I want to check the actual distance between lines agrees the dimensions. For that to make sense I also need to know if the line are parallel.
Think ouside the box. This routine is designed to do more than its apparent intent. As anyone who has used Microstation would know.

who cares about paralellness? :)
we are looking for minimum distance ie. two closest points... imho
I don't really care about parallel lines....just thought it would be fun to write :P

I tried your code. Sorry, but I doubt it will work.
Attached is an example. When I run your code and select the two lines it reprorts they are parallel, when obviously they are not.
This appoach is a deadend because parallel is essentially an angular function. Trying to compare points to determine parallel is full of pitfalls.
you're right Joe....I'll quit while I'm ahead

when talking of lines why not just use
(not (vlaxinvoke obj1 'IntersectWith obj2 acExtendBoth))
to know if they are paralell?

Lines Green & Yellow are not parallel & do not intersect. Think 3D 8)

??? Are they also noncoplanar?

Lines Green & Yellow are not parallel & do not intersect. Think 3D 8)
you are killing me :)
(defun Paral3D (obj1 obj2 / a1 a2 acos)
(setq a1 (vlaxcurvegetFirstDeriv obj1 0)
a2 (vlaxcurvegetFirstDeriv obj2 0)
acos (/ (apply '+ (mapcar '* a1 a2))
(* (sqrt (apply '+ (mapcar 'expt a1 '(2 2 2))))
(sqrt (apply '+ (mapcar 'expt a2 '(2 2 2))))
)
)
)
(zerop (atan (/ (sqrt ( 1. (* acos acos))) acos)))
)

Lines Green & Yellow are not parallel & do not intersect. Think 3D 8)
you are killing me :)
< .. >
:D
that's Alan's job :)
really interesting code guys .. nice to read

:)
;; check for parallel entities CAB 11/04/06
(defun parallel (e1 e2 pfuzz)
;; rem reduces angles > pi so range is 0  180 deg
(if (and (vlaxpropertyavailablep (vlaxename>vlaobject e1) 'angle)
(vlaxpropertyavailablep (vlaxename>vlaobject e2) 'angle))
(equal (rem (vlagetangle (vlaxename>vlaobject e1)) pi)
(rem (vlagetangle (vlaxename>vlaobject e2)) pi)
pfuzz)
)
)

Lines Green & Yellow are not parallel & do not intersect. Think 3D 8)
you are killing me :)
(defun Paral3D (obj1 obj2 / a1 a2 acos)
(setq a1 (vlaxcurvegetFirstDeriv obj1 0)
a2 (vlaxcurvegetFirstDeriv obj2 0)
acos (/ (apply '+ (mapcar '* a1 a2))
(* (sqrt (apply '+ (mapcar 'expt a1 '(2 2 2))))
(sqrt (apply '+ (mapcar 'expt a2 '(2 2 2))))
)
)
)
(zerop (atan (/ (sqrt ( 1. (* acos acos))) acos)))
)
That's some fancy math there VovKa. I like it. 8)

That's some fancy math there VovKa. I like it.
vector algebra, i feel like going back to school :)

Attached is an example file which demonstrates something I've run into while testing for parallel lines. A zero angle line after two rotations may report its angle as (* pi 2).
If the angle of the copied line is fed to the NormalAngle function contained in MinDist it will return 0.0.

(defun Paral3D (obj1 obj2 / a1 a2 acos)
(setq a1 (vlaxcurvegetFirstDeriv obj1 0)
a2 (vlaxcurvegetFirstDeriv obj2 0)
acos (/ (apply '+ (mapcar '* a1 a2))
(* (sqrt (apply '+ (mapcar 'expt a1 '(2 2 2))))
(sqrt (apply '+ (mapcar 'expt a2 '(2 2 2))))
)
)
)
(zerop (atan (/ (sqrt ( 1. (* acos acos))) acos)))
)
Alan,
While this is interesting, do you think there's any reason to revise MinDist 1.0 to use it?
I think not assuming it is only testing for parallel lines.

I see no reason to change your code. :)

I'm working on a version which allows selection of objects within blocks or xrefs at any nested depth.
Mostly done, but still a few kinks to work out.

Here's the version mentioned above named MinDist 1.3 beta. Works with objects nested in blocks or xrefs.
See the header comments for a full explanation of what's going on.
I thiink this makes the routine much more useful. Hope you agree. :)

As is the routine will toss an error if a nonuniformly scaled block is involved. I'm working on error checking for that condition.

Version 1.4 beta. Added error checking for nonuniformly scaled blocks.

Minor bug fix version named MinDist 1.4a attached. See the header comments for version history.

Thanks Joe.

Alan,
Thanks for your help with the code.

Nice job Joe :)

Thanks, ronjonp. :)

Wow this code works great! Mind i use it guys that worked on it?

Wow this code works great! Mind i use it guys that worked on it?
Glad to hear you like it. Use as you wish.
Updated version attached. Added support for object types point, ray and xline. Also works with objects nested in dimensions.

Happy New Year to All .
Hi Joe , just read your works , Good job .
However , I guess it can be get by higher Accuracy , I post my poor codes , I hope you don't mind . :)
(defun c:test
(/ en1 e en2 fuzz l1 l2 lim l0 d0 p0
p)
;;by GSLS(SS) 2012.1.2
(defun getlength (e)
(vlaxcurvegetDistAtPoint
e
(vlaxcurvegetendpoint e)
)
)
(defun f0 (a b / mid rslt)
(repeat (/ (length a) b)
(setq mid nil)
(repeat b
(setq mid (cons (car a) mid)
a (cdr a)
)
)
(setq rslt (cons (reverse mid) rslt))
)
(if a
(reverse (cons a rslt))
(reverse rslt)
)
)
(defun f1 (e p)
(distance p (vlaxcurvegetClosestPointTo e p))
)
(defun f2 (e1 e2 p lim / l0 d0 p0 l)
(setq l0 (vlaxcurvegetDistAtPoint e1 p)
d0 (f1 e2 p)
p0 p
l l0
)
(repeat 10
(setq l ( l lim))
(if (and (>= l 0) (setq p (vlaxcurvegetpointatdist e1 l)))
(if (and (setq d (f1 e2 p))
(< d d0)
)
(setq d0 d
p0 p
)
)
)
)
(setq l l0)
(repeat 10
(setq l (+ l lim))
(if (and (>= l 0) (setq p (vlaxcurvegetpointatdist e1 l)))
(if (and (setq d (f1 e2 p))
(< d d0)
)
(setq d0 d
p0 p
)
)
)
)
p0
)
(defun f3 (e1 e2 lim / mid)
(if (not
(minusp
(vlaxsafearraygetubound
(vlaxvariantvalue
(setq mid (vlaIntersectWith
(vlaxename>vlaobject e1)
(vlaxename>vlaobject e2)
lim
)
)
)
1
)
)
)
(listcomp (vlaxsafearray>list (vlaxvariantvalue mid))
3
)
)
)
(setq en1 (car (ssNentsel "\nSelect First Curve :"))
en2 (car (ssNentsel "\nSelect Second Curve :"))
)
(setq fuzz (getreal "\nType in Accuracy <1e6> :"))
(or fuzz (setq fuzz 1e6))
(if (and en1 en2)
(if (f3 en1 en2 0)
(princ "\nThe 2 Curves is intersectwithed !")
(progn
(setq l1 (getlength en1)
l2 (getlength en2)
)
(if (< l2 l1)
(setq e en1
en1 en2
en2 e
l1 l2
)
)
(setq lim (/ l1 (1+ (fix (/ l1 200.))))
l0 0.
d0 1e308
)
(repeat (fix (/ l1 lim))
(setq p (vlaxcurvegetpointatdist en1 l0))
(setq d (f1 en2 p))
(if (< d d0)
(setq d0 d
p0 p
)
)
(setq l0 (+ l0 lim))
)
(setq is_go T)
(while (and (> lim fuzz) is_go)
(setq p (f2 en1 en2 p0 (setq lim (/ lim 10.))))
(if (equal p p0 fuzz)
(setq is_go nil
p0 p
)
(setq p0 p)
)
)
(setq p (vlaxcurvegetClosestPointTo en2 p0))
(entmakex (list (cons 0 "LINE")
(cons 8 "Defpoints")
(cons 10 p0)
(cons 11 p)
(cons 62 1)
)
)
)
)
)
(princ)
)
(defun ssNentsel (msg / en en1 pt mat ins mat ent )
(setq en (Nentsel msg))
(if (= (length en) 4)
(progn
(setq en1 (car en)
pt (cadr en)
mat (caddr en)
ins (last mat)
mat (butlast mat)
mat (ssgetrcsmatrix mat ins)
)
(setq ent (entget en1 (list "*")))
(setq ent (vlremove (assoc 1 ent) ent))
(setq en1 (entmakex ent))
(if en1
(progn
(setq obj (en2obj en1))
(vlaTransformBy obj (vlaxtmatrix mat))
(setq en1 (obj2en obj))
)
)
(list en1 pt T)
)
(append en (list nil))
)
)
;;; BY GSLS(SS)
;;; 20100929
(defun ssgetrcsmatrix (lst org)
(append
(mapcar (function (lambda (x y)
(append x (list y))
))
lst
org
)
(list (list 0. 0. 0. 1.))
)
)