TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mark on October 04, 2005, 12:33:35 PM
-
Just for fun.
How many ways can you create a line [ (0 . "LINE") ] using Auto/Visual LISP?
-
Modifiy (http://www.theswamp.org/forum/index.php?topic=6977.msg85862#msg85862) to (http://www.theswamp.org/forum/index.php?topic=6977.msg85864#msg85864) suit (http://www.theswamp.org/forum/index.php?topic=6977.msg85880#msg85880).
:)
-
Here are three more ways. :-)
(if (setq sp (getpoint "\nStarting Point: "))
(if (setq ep (getpoint sp "\nEnding Point: "))
(command "_.line" sp ep "")
)
)
(if (setq sp (getpoint "\nStarting Point: "))
(if (setq ep (getpoint sp "\nEnding Point: "))
(entmake
(list
'(0 . "LINE")
'(100 . "AcDbLine")
(cons 10 sp)
(cons 11 ep)
)
)
)
)
(vl-cmdf "_.line"
(setq sp (getpoint "\nStart Point: "))
(getpoint sp "\nEnd Point: ")
""
)
-
In case anyone couldn't see how they should modify this (http://www.theswamp.org/forum/index.php?topic=6977.msg85880#msg85880) to suit here's some code to chew on --
(defun RubeGoldberg ( points / *error* document space p1 p2 )
;; a different way to handle bozo input
(cond
(
(or
(null (listp points))
(< (length points) 2)
(null
(vl-every
'(lambda (point)
(apply 'and
(mapcar
'numberp
point
)
)
)
points
)
)
)
(defun *error* (x)
(princ
(strcat
"Bozo alert: Must be a list "
"of at least 2 points.\n"
)
)
(princ)
)
(exit)
)
)
;; space, the final frontier
(setq space
(if
(zerop
(vla-get-activespace
(setq document
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
)
(vla-get-paperspace document)
(vla-get-modelspace document)
)
)
;; normalize the points (i.e. make sure they're
;; all 3D)
(setq points
(mapcar
'(lambda (point)
(while (< (length point) 3)
(setq point
(append point
'(0)
)
)
)
point
)
points
)
)
;; let's make two arrays before entering the loop
;; (instead of making them for each iterration)
;;
;; [ coded specifically to annoy Se7en ]
(mapcar
'(lambda (x)
(set x
(vlax-make-safearray
vlax-vbdouble
(cons 0 2)
)
)
)
'(p1 p2)
)
;; a more logical way to achieve
;; the same would be --
;;
;; (foreach x '(p1 p2)
;; (set x
;; (vlax-make-safearray
;; vlax-vbdouble
;; (cons 0 2)
;; )
;; )
;; )
;;
;; in the event you're going, "what
;; the .." is he talking about all the
;; crud above does the same as --
;;
;; (setq
;; p1 (vlax-make-safearray vlax-vbdouble (cons 0 2))
;; p2 (vlax-make-safearray vlax-vbdouble (cons 0 2))
;; )
;;
;; Why do I bother? Because it's fun
;; and I don't have many toys.
;; anyway, let's rock and roll --
(while (< 1 (length points))
(vlax-invoke-method
Space
'AddLine
(vlax-safearray-fill p1 (car points))
(vlax-safearray-fill p2 (cadr points))
)
(setq points (cdr points))
)
(princ)
)
-
(defun c:makealine()(command ".line"))
-
Here are two simple ways you see in routines.
(command "LINE" pause pause "")
(command "LINE")
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)
-
(command "LINE")
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)
correct me if I'm wrong but this would fail miserably wouldn't it?
-
I must correct you because you are wrong.
-
You're right, doesn't work as desired though. All of this
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)
is wasted and it requires enter to be pressed to get rid of the extra )
-
<clearing throat>
...
Eh?
-
(command "LINE")
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)pasted into the command line looks a lot likeCommand: (command "LINE")
LINE Specify first point: nil
Specify first point: (while (> (getvar "CMDACTIVE") 0)
(_> (command pause)
(_> )
Specify next point or [Undo]:
Specify next point or [Undo]:
Specify next point or [Close/Undo]:
Specify next point or [Close/Undo]:
Command: nil
He's missing the beginning bits like a(and maybe a defun or so.
-
if not, what am I missing?
-
I didn't say it's elegant, just that is doesn't fail miserably.
:)
-
I agreed with that. My last post was in response to "Eh?"
-
Sorry. It could benefit from a wrapper, agreed. Since we all know CAB is capable of a lot more than that I choose to believe he was just showing the bare minimum of what is frequently done.
:)
-
Wow Bob,
I expected some reaction from those who find it inappropriate somehow using 'Command'
in a lisp, but this was unexpected. If you've been lisping more than a month or two you
should immediately recognize a code snip-it from a functioning routine.
If you drop that code into a new window in VLIDE and run the format function it will tell you
if there are any unmatched parentheses. :kewl:
-
I recognized it as a snippet and was just messing around although I haven't lisped for somewhere in the ballpark of 15 years.
-
How about.
Peter
(defun C:MakeLine ()
(vla-addLine (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(vlax-3d-point (getpoint "\nPick First Point: "))
(vlax-3d-point (getpoint "\nPick Second Point: "))
)
)
-
(vl-vbarun "lineit")
Where exists also currently loadedOption Explicit
Sub LineIt()
Dim varStPt As Variant
Dim varEnPt As Variant
Dim booQuit As Boolean
On Error GoTo FixDaBustedness
varStPt = ThisDrawing.Utility.GetPoint(, vbCr & "First Point: ")
Do While Not booQuit
varEnPt = ThisDrawing.Utility.GetPoint(, vbCr & "Next Point: ")
If ThisDrawing.ActiveSpace = acModelSpace Then
ThisDrawing.ModelSpace.AddLine varStPt, varEnPt
Else
ThisDrawing.PaperSpace.AddLine varStPt, varEnPt
End If
varStPt = varEnPt
Loop
GwanNowHeah:
Exit Sub
FixDaBustedness:
Select Case Err.Number
Case -2145320928
booQuit = True 'I know it means nothing
GoTo GwanNowHeah
Case Else
Debug.Print Err.Number
MsgBox "To get from the left to the right, HUNH", vbCritical, "Why did the chicken cross the road?"
End Select
End Sub :evil:
-
Everyones code, but MPs, is nice. :kewl:
Bob, i like reading your code. Its fun.
But couldnt you do something like this?
Insead of this:
If ThisDrawing.ActiveSpace = acModelSpace Then
ThisDrawing.ModelSpace.AddLine varStPt, varEnPt
Else
ThisDrawing.PaperSpace.AddLine varStPt, varEnPt
End If
Do this:
If ThisDrawing.ActiveSpace = acModelSpace Then
space = ThisDrawing.ModelSpace
Else
space = ThisDrawing.PaperSpace
End If
space.AddLine varStPt, varEnPt
To make it more readable? (Or am i just wacked?...Nevermind, dont answer that.)
-
Everyones code, but MPs, is nice. :kewl:
Speak english man.
Everyone's code except MP's is nice.
:P
-
Se7en, I would tend to agree with you that it does make the code a bit more readable, and given the nature of the many things you would do in a program that requires the active space be known, it would likely be completed in a previous step ... however for the overhead of a simple program, it would save memory requirements by not creating a variable.
Often times people create a variable that is going to be used only once .. while it may make the program more readily readable, it also makes the program require more overhead, particularly if the same thing is repeated multiple times in a program.
-
Whoa, Variables, Memory, overhead?! i just wanted to pick on Bob. *Bleah* :P
(I wanted to pick on MP too, but he had to get all "Old english teacher dude" on me.)
Darn it Jim, I want a recount!!
-
Se7en ... Now that you mention it, I have a TSR that I made many years ago called WHOA and it does indeed slow down a computer ... what do I need that for you might ask? Well... many years ago, when the speed of computer CPUs were outpacing the need for them by 5 to 1 there were many programs that when run on a speed demon of a system (for example a P100) that was designed to be operated on a 486Dx33, the thing would go so fast that you would have problem with the output, and the program was useless ... so, to make these programs work at the desired speed, we could run WHOA once, twice or 10 times (depending upon how slow we needed the system to go) and then run our nice slow program ... can you imagine intentionally telling the processor to skip every third cycle, or every other cycle ... or rather devote only 1 cycle per 10 to the current application .... lotta fun that one ... WHOA ... still cracks me up ...
-
*blink* A "P100"!? ...Im using a P4! (I didnt even see the p5 comeout?!)
:ugly:
-
don't blink too often, you might miss the next generation ... the awesome P166MMX (you do remember MMX ... what the heck ever happened to that?)
-
Here is yet a way to create a LINE
(http://www.rollertec.co.uk/images/tutorial_basic_vertlines.gif)
-
Here is yet a way to create a LINE
(http://www.rollertec.co.uk/images/tutorial_basic_vertlines.gif)
Yes!
I still use the parallel glider, some times.... so another would be:
Parallel rule
T rule
Universal rule
...
-
*Thinking how Se7en could create a line*
http://www.theswamp.org/screens/Maverick/flatline.jpg
-
Looks like my lines until I've had my coffee.
-
*Thinking how i shall call that line "Maverick"*
-
Here liney liney liney.
-
Here is a semi-serious way to draw lines - parallel to each other by just moving the cursor to front or back to paint the lines.... this is just for fun....
Luis.
(vl-load-com)
(setq 45Degrees (* pi 0.25))
(setq 90Degrees (* pi 0.5))
(setq 135Degrees (* pi 0.75))
(setq 225Degrees (* pi 1.25))
(setq 270Degrees (* pi 1.5))
(setq 315Degrees (* pi 1.75))
(setq 360Degrees (* pi 2.0))
(if (not *Acad)
(setq *Acad (vlax-get-acad-object)))
(defun thisDwg () (vla-get-activeDocument *Acad))
(setq
dtt_thisdwg
(cond (dtt_thisdwg)
((thisDwg))))
(if (not Model)
(setq Model
(vla-get-modelSpace dtt_thisdwg)))
(defun pSpace () (vla-get-paperSpace dtt_thisdwg))
(defun get-activeSpace ()
(if (= acModelSpace (vla-get-activeSpace dtt_thisdwg))
Model
(if (= (vla-get-mSpace dtt_thisdwg) :vlax-true)
Model
(pSpace))))
(defun lc-write2file (n / file p search)
(setq search (acadFolder))
(setq file (open (strcat search "$par$") "a"))
(write-line n file)
(close file))
(defun lc-readFile (/ file n tmp search)
(setq search (acadFolder))
(if (findfile (strcat search "$par$"))
(progn
(setq file (open (findfile (strcat search "$par$")) "r"))
(while (setq n (read-line file))
(if (/= n "")
(setq tmp (append tmp (list n)))))
(close file)))
tmp)
(defun lc-file2nil (/ search)
(setq search (acadFolder))
(if (findfile (strcat search "$par$"))
(vl-file-delete (findfile (strcat search "$par$")))
nil))
(defun acadFolder ()
(substr (findfile "acad.exe")
1
(- (strlen (findfile "acad.exe")) 8)))
(defun point2String (pt)
(strcat (rtos (car pt) 2 6)
(rtos (cadr pt) 2 6)
(rtos (caddr pt) 2 6)))
(defun rtd (a) (* (/ a pi) 180.0))
(defun lc-angle (/ p1 ang)
(setq p1 (getpoint "\n<Select LINE>/From point: "))
(if p1
(progn
(setq
ang (getangle
(strcat "\nAlignment angle <"
(rtos (rtd Atemp) 2 0)
">: ")
p1))
(if (= ang nil)
(setq ang Atemp)
(setq Atemp ang))
(setvar "orthomode" 1)
(list ang p1))
nil))
(defun lc-vector (/ anglin ang p1 sep)
(setq sna (getvar "snapang"))
(setq anglin (lc-angle))
(if anglin
(progn
(setq ang (car anglin))
(setq p1 (cadr anglin))
(setvar "snapang" ang)
(setq size (getvar "cursorsize"))
(setvar "cursorsize" 1)
(initget 6)
(setq sep
(getdist p1
(strcat "\nTo point/Distance <"
(rtos ll)
">: ")))
(if (= sep nil)
(setq sep ll))
(if (not ll)
(setq ll 1.0))
(setq ll sep)
(if sna
(setvar "snapang" sna))
(if size
(setvar "cursorsize" size))
(list p1 (polar p1 ang sep)))
nil))
(defun addLine (start_point end_point / vla_line)
(if (and start_point
end_point
(not (vl-catch-all-error-p
(setq
vla_line
(vl-catch-all-apply
'vla-addLine
(list (get-activeSpace)
(vlax-3d-point start_point)
(vlax-3d-point end_point)))))))
vla_line))
(defun C:CLINE (/ p1 p2 p3 p4 sep lcopyent
entlist m s n c lst
obj take code5 mklin)
(if (not Atemp)
(setq Atemp 0.0))
(if (not ll)
(setq ll 1.0))
(lc-file2nil)
(setq lst nil)
(setq mklin (lc-vector))
(if (= mklin nil)
(setq obj (entsel "\nSelect line: "))
(progn (setq p1 (car mklin)) (setq p2 (cadr mklin))))
(if (and obj (= (cdr (assoc 0 (entget (car obj)))) "LINE"))
(progn
(setq lcopyent (car obj))
(setq
entlist (entget lcopyent)
p1 (cdr (assoc 10 entlist))
p2 (cdr (assoc 11 entlist)))))
(setq lst (lc-readFile))
(if (and p1 p2)
(progn
(if (and (not (member (point2String p1) lst))
(not (member (point2String p2) lst)))
(addLine p1 p2))
(if (not (member (point2String p1) lst))
(lc-write2file (point2String p1)))
(if (not (member (point2String p2) lst))
(lc-write2file (point2String p2)))
(setq lst (lc-readFile))))
(if p1
(progn
(setvar "orthomode" 0)
(initget 6)
(setq sep
(getdist
(strcat
"\nSelect two point/<Distance between them = "
(rtos ll)
">: ")))
(if (= sep nil)
(setq sep ll))
(if (not ll)
(setq ll 1.0))
(setq ll sep)))
(if (and p1 p2 sep)
(progn
(prompt
"\n<ENTER to exit>/Move cursor to copy")
(while (not (equal (setq take (grread 't)) '(2 13)))
(setq code5 (car take))
(setq p3 (cadr take))
(if (and p3 (= 5 code5))
(progn
(setq
p4
(inters p1
p2
p3
(polar p3
(+ (angle p1 p2) 90Degrees)
1.0)
nil))
(setq
p1 (polar p1 (angle p4 p3) sep)
p2 (polar p2 (angle p4 p3) sep))
(setq lst (lc-readFile))
(if (and p1 p2)
(progn
(if
(and
(not (member (point2String p1)
lst))
(not (member (point2String p2)
lst)))
(addLine p1 p2))
(if
(not (member (point2String p1) lst))
(lc-write2file (point2String p1)))
(if
(not (member (point2String p2) lst))
(lc-write2file (point2String p2))))))
(progn
(prompt
"\r<ENTER to exit>/Move cursor to copy")
(alert
"\nWork on current window, other command are disabled\nUse mouse scroll button to zoom in out or pan."))))))
(setvar "snapang" 0.0)
(princ))
(princ "\nCLINE by www.geometricad.com ")
(princ)
-
like others...
you can make (command "_.line")
or (vl-cmdf "_.line)
and so on...
But you can also use PLINE with width "0" or command "Trace"..do you forget it ?
you can use "_.SPLINE" "_.XLINE" "_.RAY" depending what you need..
You can make a block containing a simple line at length "0" and insert it, stretch it and...
you can use "(entmake)" <- (I prefer this when it's possible)
why ? because lot of version with lot of language..English / French and blah blah blah..
so the command is not the same. but if you want to use the "LINE" command...
don't forget to put the "_." before !
otherwise...... :pissed: