TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: rugaroo on September 27, 2003, 01:58:26 PM

Take a look at the following pdf file from my local book of design standards.
Sight Visibility Zones  201.2 (http://www.rtc.co.clark.nv.us/pdf/streetspdf/USDV1/201.2.pdf)
How hard do you guys think it would be to write a lisp to automatically draw the sight zones?
I tried to start write something before, but never got to be too successful with that. Here is what I had:
(DEFUN c:svz ()
(SETQ cmd (GETVAR "cmdecho"))
(SETVAR "cmdecho" 0)
(SETQ arc (ENTSEL "\nSelect intersection arc: "))
(SETQ starc (GETPOINT (VLAX3DPOINT (VLAXCURVEGETSTARTPOINT arc)))
endarc (GETPOINT (VLAX3DPOINT (VLAXCURVEGETENDPOINT arc)))
)
(VLCMDF "line" starc endarc "")
(setq chord (vlaxename>vlaobject (entlast)))
(setq minrow (entsel "\nSelect minor right of way line: ")
minlin (vlaxename>vlaobject minrow)
)
(setq majrow (entsel "\nSelect major right of way line: ")
majlin (vlaxename>vlaobject majrow)
)
(PRINC)
)
At least this will give you an idea of where I was possibly headed.
Rug

Doesn't look hard. Seems like a question of a few parameters and then looking up values in a table.
By the way, what's a row?
I don't know if your code is on the right track yet, but at least it could use an overhaul:
(defun c:svz ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond ((setq arc (entsel "\nSelect intersection arc: "))
(setq arc (vlaxename>vlaobject (car arc))
starc (vlaxcurvegetstartpoint arc)
endarc (vlaxcurvegetendpoint arc)
)
(vlcmdf "line" starc endarc "")
(setq chord (vlaxename>vlaobject (entlast)))
(cond ((and (setq minrow (entsel "\nSelect minor right of way line: "))
(setq majrow (entsel "\nSelect major right of way line: "))
)
(setq minlin (vlaxename>vlaobject (car minrow))
majlin (vlaxename>vlaobject (car majrow))
)
)
)
)
)
(setvar "cmdecho" cmd)
(princ)
)

Not to do it for you, I'll give you some functions to think about that should help.
 intersectWith method in ActiveX and VBA Reference
That will give you the imaginary intersection of two selected objects.
 polar funtion.
That will help you move a point along two points in any direction. Lines are fairly simple, but arcs might require some more math. Take a look at that one function I gave you that caused the offsets to be reversed. I believe I have some work for arcs in there.

Madsen / Daron 
Thanks. What I had posted was rough.
Row  Right of way...pretty much a dedication of land for the development of roadways. Mark may have a more detailed explaination, but that is the just of it.
I totally forgot about the intersect with. That will make things a lot easier. However, I don't know much about that or the polar function...I will go do some reading and see if I can get something together

How would I fix this to where it sets my variables correctly:
(defun getvars ()
(setq minwdt (getreal "\nWhat is the minor R/W width: ")
majwdt (getreal "\nWhat is the major R/W width: ")
)
(if
(and
((= minwdt 48) (= majwdt 48))
(setq a 53
b 6
c 6
d 42
)
)
)
(if
(and
((= minwdt 48) (= majwdt 51))
(setq a 39
b 5
c 5
d 31
)
)
)
(if
(and
((= minwdt 48) (= majwdt 60))
(setq a 66
b 5
c 5
d 55
)
)
)
(if
(and
((= minwdt 48) (= majwdt 80))
(setq a 100
b 6
c 5
d 36
)
)
)
(if
(and
((= minwdt 48) (= majwdt 100))
(setq a 184
b 6
c 5
d 53
)
)
)
(if
(and
((= minwdt 51) (= majwdt 48))
(setq a 51
b 6
c 6
d 40
)
)
)
(if
(and
((= minwdt 51) (= majwdt 51))
(setq a 37
b 4
c 4
d 29
)
)
)
(if
(and
((= minwdt 51) (= majwdt 60))
(setq a 64
b 5
c 5
d 53
)
)
)
(if
(and
((= minwdt 51) (= majwdt 80))
(setq a 98
b 6
c 5
d 34
)
)
)
(if
(and
((= minwdt 51) (= majwdt 100))
(setq a 182
b 6
c 5
d 51
)
)
)
(if
(and
((= minwdt 60) (= majwdt 48))
(setq a 46
b 6
c 6
d 50
)
)
)
(if
(and
((= minwdt 60) (= majwdt 51))
(setq a 33
b 4
c 4
d 37
)
)
)
(if
(and
((= minwdt 60) (= majwdt 60))
(setq a 56
b 5
c 5
d 48
)
)
)
(if
(and
((= minwdt 60) (= majwdt 80))
(setq a 90
b 5
c 4
d 30
)
)
)
(if
(and
((= minwdt 60) (= majwdt 100))
(setq a 174
b 6
c 5
d 47
)
)
)
(if
(and
((= minwdt 80) (= majwdt 60))
(setq a 56
b 6
c 6
d 58
)
)
)
(if
(and
((= minwdt 80) (= majwdt 80))
(setq a 73
b 6
c 6
d 35
)
)
)
(if
(and
((= minwdt 80) (= majwdt 100))
(setq a 157
b 6
c 6
d 58
)
)
)
(if
(and
((= minwdt 100) (= majwdt 80))
(setq a 56
b 4
)
)
)
(if
(and
((= minwdt 100) (= majwdt 100))
(setq a 140
b 5
)
)
)
)
Rug

I would put a table like that into an association list and make a function that returns values of A, B, C and D as a list
(defun getvars (minwdt majwdt / table)
(setq table '((48 (48 53 6 6 42) (51 39 5 5 31) (60 66 5 5 55)
(80 100 6 5 36) (100 184 6 5 53))
(51 (48 51 6 6 40) (51 37 4 4 29) (60 64 5 5 53)
(80 98 6 5 34) (100 182 6 5 34))
(60 (48 46 6 6 50) (51 33 4 4 37) (60 56 5 5 48)
(80 90 5 4 30) (100 174 6 5 47))
(80 (60 56 6 6 58) (80 73 6 6 58) (100 157 6 6 58))
(100 (80 56 4 0 0) (100 140 5 0 0))
)
)
(cdr (assoc majwdt (cdr (assoc minwdt table))))
)
Then, in your calling function, I would set the variables in a manner similar to this:
(mapcar 'set '(a b c d)(getvars minor major))
For example, (mapcar 'set '(a b c d)(getvars 60 51)) would give (33 4 4 37) and set A, B, C and D accordingly. Of course, if minwdt is 100 then C and D would be 0, but make sure that you handle this case in the calling function.
PS: If you copy the above list then please look it over for typos.

Madsen 
The reason I didn't do a list, is cause I know nothing about them...I am pretty much a newbie, and migrated this way from cadalog because of Mark. I think I see what you are doing though, and will do a bit more reading and see what I can do.
Thx
Rug

Nothing is better to enhance your skills than to solve a task as the excellent one you've chosen. When it's done you'll be a beginner no more :)
Maybe I can explain the code I posted in a little more detail. Picking values from a table on the basis of a few parameters (minwdt and majwdt) is comparable to a 'select case' case. Functions like COND and IF can do the job as you just showed, but if you had hell writing all those IF's then imagine what it'll be like next time new standards for intersection visibility arrive. Besides, executionwise it's slow and codewise it's not very clear.
If you look at the table that you are querying, you'll notice that you have two parameters and then four possible values. This can be set up like this:
minwdt majwdt A B C D
48 48 53 6 6 42
48 51 39 5 5 31
...
60 48 46 6 6 50
60 51 33 4 4 37
...
This means that if you can lookup minwdt in the table then you'll end up having x choices that only depends on majwdt. Subsequently, if you can lookup majwdt among those x choices then you'll hit a result.
How to set this up in a list? Well, AutoLISP has an excellent lookupfunction called ASSOC. You use it all the time when looking up entity definition data. It looks for the first value in a list and returns the entire list if it's a match.
You could for example do this, where minwdt and majwdt are the first two item in each sublist:
(setq table (list (list 48 48 53 6 6 42)(48 51 39 5 5 31)(list 60 48 46 6 6 50)))
> ((48 48 53 6 6 42)(48 51 39 5 5 31)(60 48 46 6 6 50))
(assoc 48 table)
> (48 48 53 6 6 42)
So far so good. ASSOC enables you to lookup minwdt of 48. Querying the next item in the list could yield a match for majwdt. But ASSOC only returns the first sublist it encounters that has 48 as the first item  and you will have at least 5 sublists with 48 as CAR item.
So, trick is to return all possible values where minwdt can be 48:
(setq table (list (list 48 (list 48 53 6 6 42)(list 51 39 5 5 31))(list 60 (list 48 46 6 6 50))))
> ((48 (48 53 6 6 42)(51 39 5 5 31))(60 (48 46 6 6 50)))
(assoc 48 table)
> (48 (48 53 6 6 42)(51 39 5 5 31))
Now you have all possible matches for minwdt = 48. Next step is simply to look for majwdt among those matches. First you'll have to remove the first item in the returned list with CDR and then perform ASSOC again:
(setq match (cdr (assoc 48 table)))
> ((48 53 6 6 42)(51 39 5 5 31))
(assoc 51 match)
> (51 39 5 5 31)
Removing the first item (which is majwdt) from this list will give you a clean list of values for A, B, C and D:
(cdr (assoc 51 match))
> (39 5 5 31)
Doing these tasks in one sweep is what was included in the posted code:
(cdr (assoc 51 (cdr (assoc 48 table))))
> (39 5 5 31)
You don't have to worry about the MAPCAR that follows if you want to save the trickier stuff till later. It can be written like this instead:
(setq a (car match)
b (cadr match)
c (caddr match)
d (cadddr match)
)
... or ...
(setq a (nth 0 match)
b (nth 1 match)
c (nth 2 match)
d (nth 3 match)
)

WOW....thanks Madsen...I am still barely awake, and that worked great. Thanks for the little tutorial...Let me figure out some more things and see if I can get this program done today. But in the mean time, let me see if I get this right.
(defun getvars (minwdt majwdt / table)
(setq table '((48 (48 53 6 6 42) (51 39 5 5 31) (60 66 5 5 55)
(80 100 6 5 36) (100 184 6 5 53))
(51 (48 51 6 6 40) (51 37 4 4 29) (60 64 5 5 53)
(80 98 6 5 34) (100 182 6 5 34))
(60 (48 46 6 6 50) (51 33 4 4 37) (60 56 5 5 48)
(80 90 5 4 30) (100 174 6 5 47))
(80 (60 56 6 6 58) (80 73 6 6 58) (100 157 6 6 58))
(100 (80 56 4 0 0) (100 140 5 0 0))
)
)
(cdr (assoc majwdt (cdr (assoc minwdt table))))
)
How am i to set my a/b/c/d now from this? I know car, cadr caddr cadddr will returns the values in perspective order, but from there I am lost.
Thx
Rug

rugaroo, you're welcome.
Your last question does not compute. I just showed you three ways to assign the variables!
However, it seems that the only variable parameters are major ROW, minor ROW and ROW radius. Any other distances and values are given by the table, so as I see it, you would include D1 and D2 for each case along with the cases 3A, 3B, 3C and 3D where applicable. If your question was meant as how you proceed to grab those parameters then I understand it.
But answering that would be writing the code for you :)

Daaaaamn! :lol: Welcome abord Stig. VERY nice. Thanks for the lesson.
Rug, just a little side note; Stig is a heavy hitter when it comes to lisp. (He likes giving me headaches with his code, so beware of his stuff. Mark and I are extremly happy to have him here.) If you plan on REALLY learning how the language works, then grab a big cup of coffee and sit down with some of his functions for a few hours.

Madsen, in your tutorial you posted:
(setq a (car match)
b (cadr match)
c (caddr match)
d (cadddr match)
)
... or ...
(setq a (nth 0 match)
b (nth 1 match)
c (nth 2 match)
d (nth 3 match)
)
Would I replace the match with my table name? That is what I was really trying to ask...As far as the D1 and D2 go, the only time that we use those is when a traffic engineer feels as though our SVZ's are inaddequite. The tables in the link I orginally provided are the minimum requirements, and are to be followed as shown, unless specifically asked otherwise.
7  Believe me, you, Mark, Daron and Madsen are all 'heavy hitters' in my book. The things I have seen you guys do for me and others is just unbelieveable, and I am doing more than taking notes.
Rug

Oh ok, guess it could have been clearer. Yes, you would fetch the values from getvars and then use the list it returns:
(defun C:SVZ (/ match minwdt majwdt a b c d)
(setq minwdt (getdist "Specify minor R/W width: ")
majwdt (getdist "\nSpecify major R/W width: ")
)
(cond ((and minwdt majwdt)
;;... verification of inputs could go here
(setq match (getvars minwdt majwdt))
(setq a (nth 0 match)
b (nth 1 match)
c (nth 2 match)
d (nth 3 match)
)
;;... further processing could go here
)
)
)
Se7en, thanks for the welcome.

here is what I did, but it is pretty ugly, and I am not sure where I am going wrong. No I can't try vlide cause it is not opening any more...I have to reinstall i think...
(defun GETVARS (MINWDT MAJWDT / TABLE)
(setq TABLE '((48
(48 53 6 6 42)
(51 39 5 5 31)
(60 66 5 5 55)
(80 100 6 5 36)
(100 184 6 5 53)
)
(51
(48 51 6 6 40)
(51 37 4 4 29)
(60 64 5 5 53)
(80 98 6 5 34)
(100 182 6 5 34)
)
(60
(48 46 6 6 50)
(51 33 4 4 37)
(60 56 5 5 48)
(80 90 5 4 30)
(100 174 6 5 47)
)
(80 (60 56 6 6 58) (80 73 6 6 58) (100 157 6 6 58))
(100 (80 56 4 0 0) (100 140 5 0 0))
)
)
(cdr (assoc MAJWDT (cdr (assoc MINWDT TABLE))))
)
(defun CIRCLEMAKE (INT RAD /)
(entmake (list
(cons 0 "CIRCLE")
(cons 100 "ACDBENTITY")
(cons 100 "ACDBCIRCLE")
(cons 10 INT)
(cons 40 RAD)
)
)
)
(defun C:SVZ (/ MATCH MINWDT MAJWDT A B C D)
(setq MINWDT (getdist "Specify minor R/W width: ")
MAJWDT (getdist "\nSpecify major R/W width: ")
)
(cond ((and MINWDT MAJWDT)
(setq MATCH (GETVARS MINWDT MAJWDT))
(setq A (nth 0 MATCH)
B (nth 1 MATCH)
C (nth 2 MATCH)
D (nth 3 MATCH)
)
)
)
(setq CMD (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond
((setq ARC (entsel "\nSelect intersection arc: "))
(setq ARC (vlaxename>vlaobject (car ARC))
STARC (vlaxcurvegetstartpoint ARC)
ENDARC (vlaxcurvegetendpoint ARC)
)
(vlcmdf "line" STARC ENDARC "")
(setq CHORD (vlaxename>vlaobject (entlast)))
(cond
((and (setq MINROW (entsel "\nSelect minor right of way line: "))
(setq MAJROW (entsel "\nSelect major right of way line: "))
)
(setq MINLIN (vlaxename>vlaobject (car MINROW))
MAJLIN (vlaxename>vlaobject (car MAJROW))
)
)
)
(GETVARS)
(vlcmdf "offset" MAJLIN B "")
(setq MAJTMP (vlaxename>vlaobject (car (entlast))))
(CIRCLEMAKE (vlaintersectwith MINROW MAJROW) A)
(setq ACIR (vlaxename>vlaobject (car (entlast))))
(vlcmdf "line"
(vlaintersectwith ACIR MAJROW)
(vlaintersectwith MAJTMP CHORD)
""
"erase"
ACIR
MAJTMP
""
)
)
)
(setvar "cmdecho" CMD)
(princ)
)
Rug

Does anyone have a small and simple example on how to use the intersectwith method? I read throught the help files, but didnt find anything that really helps 'me'...just a small example will do :)

Show us what you've tried.

Here is what I have done up to now.
(defun GETVARS (MINWDT MAJWDT / TABLE)
(setq TABLE '((48
(48 53 6 6 42)
(51 39 5 5 31)
(60 66 5 5 55)
(80 100 6 5 36)
(100 184 6 5 53)
)
(51
(48 51 6 6 40)
(51 37 4 4 29)
(60 64 5 5 53)
(80 98 6 5 34)
(100 182 6 5 34)
)
(60
(48 46 6 6 50)
(51 33 4 4 37)
(60 56 5 5 48)
(80 90 5 4 30)
(100 174 6 5 47)
)
(80 (60 56 6 6 58) (80 73 6 6 58) (100 157 6 6 58))
(100 (80 56 4 0 0) (100 140 5 0 0))
)
)
(cdr (assoc MAJWDT (cdr (assoc MINWDT TABLE))))
)
(defun CIRCLEMAKE (INT RAD /)
(entmake (list
(cons 0 "CIRCLE")
(cons 100 "ACDBENTITY")
(cons 100 "ACDBCIRCLE")
(cons 10 INT)
(cons 40 RAD)
)
)
)
(defun C:SVZ (/ MATCH MINWDT MAJWDT A B C D)
(setq MINWDT (getdist "Specify minor R/W width: ")
MAJWDT (getdist "\nSpecify major R/W width: ")
)
(cond ((and MINWDT MAJWDT)
(setq MATCH (GETVARS MINWDT MAJWDT))
(setq A (nth 0 MATCH)
B (nth 1 MATCH)
C (nth 2 MATCH)
D (nth 3 MATCH)
)
)
)
(setq CMD (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond
((setq ARC (entsel "\nSelect intersection arc: "))
(setq ARC (vlaxename>vlaobject (car ARC))
STARC (vlaxcurvegetstartpoint ARC)
ENDARC (vlaxcurvegetendpoint ARC)
)
(vlcmdf "line" STARC ENDARC "")
(setq CHORD (vlaxename>vlaobject (entlast)))
(cond
((and (setq MINROW (entsel "\nSelect minor right of way line: "))
(setq MAJROW (entsel "\nSelect major right of way line: "))
)
(setq MINLIN (vlaxename>vlaobject (car MINROW))
MAJLIN (vlaxename>vlaobject (car MAJROW))
)
)
)
(GETVARS)
(vlcmdf "offset" MAJLIN B "")
(setq MAJTMP (vlaxename>vlaobject (car (entlast))))
(CIRCLEMAKE (vlaintersectwith MINROW MAJROW) A)
(setq ACIR (vlaxename>vlaobject (car (entlast))))
(vlcmdf "line"
(vlaintersectwith (ACIR MAJROW))
(vlaintersectwith (MAJTMP CHORD))
""
"erase"
ACIR
MAJTMP
""
)
)
)
(setvar "cmdecho" CMD)
(princ)
)

(setq ARC (vlaxename>vlaobject (car ARC))
STARC (vlaxcurvegetstartpoint ARC)
ENDARC (vlaxcurvegetendpoint ARC)
)
(vlcmdf "line" STARC ENDARC "")
I haven't tried or spent much time on this yet, but at first glance it seems we need to ween you of the vlcmdf crutch. You've got a start point and an endpoint. You need to put this (setq model (vlagetmodelspace (vlagetactivedocument (vlaxgetacadobject)))) in the code and then
(vlaaddLine model starc endarc) in place of vlcmdf. If you're going to go through the vlaobject, you may as well finish by creating one.[/quote][/code]