TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TimSpangler on December 29, 2005, 10:14:15 AM
-
I am playing aroung with grread, grdraw, grvecs, to become more familiar and to hopefully learn something new. THis is my first time attempting drawing to the drawing area. I am triing to draw a simple square to the drawing area using grread to get the cursor position and ghost the image to the cursor as i drag around the drawing area. Now how do I select an insertion point and have the square follow the cursor? I want the square to rotate around the the insertion point till I pick the last point?
Any code examples that I can study will be greatly appreciated.
TIA
-
http://www.theswamp.org/forum/index.php?topic=6958.0
http://www.theswamp.org/forum/index.php?topic=6949.0
:-)
-
(DEFUN c:testbox (/ pt1)
(drawabox (SETQ pt1 (GETPOINT)) (GETCORNER pt1) 5)
)
(DEFUN drawabox (point1 point2 clr / todraw yval xdist ydist)
(SETQ todraw nil)
(SETQ xdist (ABS (- (CAR point1) (CAR point2))))
(SETQ ydist (ABS (- (CADR point1) (CADR point2))))
(SETQ yval 0.025)
(WHILE (< yval ydist)
(SETQ todraw (APPEND todraw
(LIST clr
(plus point1 (LIST 0 yval 0))
(plus point1 (LIST xdist yval 0))
)
)
)
(SETQ yval (+ yval 0.025))
)
(SETQ xval 0.025)
(WHILE (< xval xdist)
(SETQ todraw (APPEND todraw
(LIST clr
(plus point1 (LIST xval 0 0))
(plus point1 (LIST xval ydist 0))
)
)
)
(SETQ xval (+ xval 0.025))
)
(GRVECS todraw)
)
(DEFUN movingbox (dimx dimy xoff yoff clr / endpt thepoint)
(WHILE (= 5 (CAR (SETQ endpt (GRREAD T 5 1))))
(REDRAW)
(drawabox (SETQ thepoint (plus (LIST xoff yoff 0) (CADR endpt)))
(plus thepoint (LIST dimx dimy 0))
clr
)
)
(CADR endpt)
)
here's my box fun, you could probably find some rotation matrix stuff somewhere on here, or google it..
-
Need your PLUS finction.
Gary
-
Heres one:
(defun c:test ()
(setq time T)
(while time
(setq drag (grread t 1 1))
(cond ((= (car drag) 5) ;<- moving cursor
(setq ghostpt (cadr drag))
(setq pt1 (polar ghostpt 0.0 5.0))
(setq pt2 (polar ghostpt (* pi 1.5) 5.0))
(setq pt3 (polar pt2 0.0 5.0))
;;(setq pt4 (polar ghostpt (* pi 1.5) 5.0))
(redraw) ; draw vectors
(grvecs (list 7 ghostpt pt1 7 pt1 pt3 7 pt3 pt2 7 pt2 ghostpt))
)
((= (car drag) 3) ;<- picked point
(setq ghostpt (cadr drag))
(redraw) ; draw what you preview
(command "._line" ghostpt pt1 pt3 pt2 "_C")
(setq time nil)))))
Gary
-
... you could probably find some rotation matrix stuff somewhere on here, or google it..
This is some code that I was working on for an article on the site a couple of years ago and ended up dropping it before it was complete. It's in terrible shape and nearly impossible to follow, but *maybe* you can glean something useful out of it :|
I left off just before I got to the part of having the ghosted objects follow the cursor. From a high level perspective, what you'll have to do is capture the cursor position, compare it to the previous position, and transform the objects from the old to the new position. I have yet to do this in LISP, but I have done it in .NET. You can see that code over in the .NET list, http://www.theswamp.org/forum/index.php?topic=8195.0 and http://www.theswamp.org/forum/index.php?topic=8198.0
This is the main function
Type "DrawShape" to start the command.
(defun c:drawShape (/ basePt rotation grInput grRetVal sFac
dragPnt vector matrix pMatrix Color
pColor ptLst shape *error*
)
(defun *error* (msg)
(if (not
(member
Msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
)
(progn
(princ (strcat "\nError #" (itoa (getvar "ERRNO")) ": " Msg)
)
(setvar "ERRNO" 0)
)
)
;;erase last vectors
(if pMatrix
(grDrClosedShape pColor ptLst pMatrix)
)
(princ)
)
(initget "Rectangle1 rEctangle2")
(setq shape (getkword "\nShape to draw [Rectangle1/rEctangle2] <Rectangle1>")
shape
(cond
((equal shape "rEctangle2") 'rectangle2)
(t 'rectangle1)
)
basePt (getpoint "\nSelect point: ")
)
(if basePt
(progn
(setq sFac (/ (car (getvar "SCREENSIZE")) 1000)
vector (mapcar '- basePt)
ptLst ((eval shape) basePt)
grInput 5
)
;;---------------------------
;;Loop while user moves mouse
;;---------------------------
(while (= grInput 5)
;;-------------------------
;;get data from GRREAD
;;-------------------------
(setq grRetVal (grread t 5 0)
grInput (car grRetVal)
dragPnt (cadr grRetVal)
rotation (angle basePt dragPnt)
color 300
;;-------------------------------------
;;Build Transformation matrix from data
;;-------------------------------------
matrix (bldTformMatrix
(list
(TranslateMatrix basePt)
(ScaleMatrix (/ (distance basePt dragpnt) sFac))
(TranslateMatrix Vector)
(TranslateMatrix basePt)
(RotateZMatrix rotation)
(TranslateMatrix Vector)
)
)
)
;;erase previous vectors
(if pMatrix
(grDrClosedShape pColor ptLst pMatrix)
)
;;Draw vectors
(grDrClosedShape Color ptLst Matrix)
;;Save current grvecs information
(setq pMatrix matrix
pColor Color
)
)
;;erase last vectors
(grDrClosedShape Color ptLst Matrix)
(command "_.pline")
(foreach pt (transPts ptLst Matrix)
(command pt)
)
(command "_C")
)
(princ)
)
)
This helper function will grdraw a closed shape
;;;Draw closed shape with GRVECS
;;;(grDrClosedShape 7 '((1 1) (2 1) (2 2) (1 2)) myMatrix)
(defun grDrClosedShape (color ptLst matrix)
(grvecs
(append
(list color)
(cdr
(apply
'append
(mapcar
'(lambda (pt)
(list pt pt)
)
ptlst
)
)
)
(list (car ptLst))
)
matrix
)
)
These functions define a couple of closed rectangles. You can create others and pass them to the grDrClosedShape() function. They do not have to be rectangles.
;;;Define the shape of the vectors to draw
;;;via a list of points as they relate to a supplied
;;;base point. This is a rectangle with the
;;;base point being the lower left corner.
(defun Rectangle1 (pt / x y xVect yVect)
(mapcar '(lambda (val var) (set var (/ val 1000.0)))
(getvar "SCREENSIZE")
'(xVect yVect)
)
(setq x (car pt)
y (cadr pt)
)
(list
pt ;LL
(list (+ x xVect) y) ;LR
(list (+ x xVect) (+ y yVect)) ;UR
(list x (+ y yVect)) ;UL
)
)
;;;This is a rectangle with the base point being the
;;;center of the rectangle.
(defun Rectangle2 (pt / x y hxVect hyVect)
(mapcar '(lambda (val var) (set var (/ val 1000.0)))
(getvar "SCREENSIZE")
'(xVect yVect)
)
(setq x (car pt)
y (cadr pt)
hxVect (* 0.5 xVect)
hyVect (* 0.5 yVect)
)
(list
(list (- x hxVect) (- y hyVect)) ;LL
(list (+ x hxVect) (- y hyVect)) ;LR
(list (+ x hxVect) (+ y hyVect)) ;UR
(list (- x hxVect) (+ y hyVect)) ;UL
)
)
These are the Matrix helper functions
;;;Special thanks to Vladimir Nesterovsky
;;;for these four matrix manipulation routines
;;;a dot product of the two vectors, u & v
(defun dotprod (u v)
(apply '+ (mapcar '* u v))
)
;;;transpose a matrix
;;;code by doug Wilson
(defun transpose (m)
(apply 'mapcar (cons 'list m))
)
;;;Apply a transformation matrix to a vector
(defun mxv (m v)
(mapcar '(lambda (row) (dotprod row v))
m
)
)
;;;Multiply two matrices
(defun mxm (m q)
(setq q (transpose q))
(mapcar '(lambda (row) (mxv q row))
m
)
)
;;;Scale matrix
;;;We add error handling to this matrix to
;;;ensure that we never have a zero scale factor.
;;;It accepts a single scale factor for the
;;;X, Y, & Z or a list of factors in the order
;;;of '(X Y Z).
;;;(ScaleMatrix 3.5)
;;;(ScaleMatrix '(3 2 1))
(defun ScaleMatrix (Scale / ScaleX ScaleY ScaleZ)
(mapcar
'(lambda (var scl)
(if (zerop scl)
(set var 1)
(set var scl)
)
)
'(ScaleX ScaleY ScaleZ)
(if (listp scale)
Scale
(list Scale Scale Scale)
)
)
(list (list ScaleX 0 0 0)
(list 0 ScaleY 0 0)
(list 0 0 ScaleZ 0)
(list 0 0 0 1)
)
)
;;;Rotate about Z axis
;;;Rotation to be supplied in radians
;;;(RotateZMatrix (* pi 3.33))
(defun RotateZMatrix (Rot)
(list (list (cos Rot) (- (sin Rot)) 0 0)
(list (sin Rot) (cos Rot) 0 0)
(list 0 0 1 0)
(list 0 0 0 1)
)
)
;;;Translate Matrix
;;;Vector is a list of values
;;;in the order of '(X Y Z) to
;;;move a point
;;;(TranslateMatrix '(3 4 0))
(defun TranslateMatrix (Vector)
(list (list 1 0 0 (car Vector))
(list 0 1 0 (cadr Vector))
(list 0 0 1 (caddr Vector))
(list 0 0 0 1)
)
)
;;;Apply a 3d Transformation matrix
;;;to a list of points. Points can
;;;be 2d or 3d points.
;;;(TransPts '((1 1 0) (2 3 0) (1 3 0)) (ScaleMatrix 2))
(defun TransPts (ptLst Matrix)
(mapcar
'(lambda (pt / ptDim)
(setq ptDim (length pt)
pt
(if (= ptDim 3)
(reverse (cons 1 (reverse pt)))
(reverse (cons 1 (cons 0 (reverse pt))))
)
)
(reverse
(apply
(if (= ptDim 3)
'cdr
'cddr
)
(list
(reverse
(mxv Matrix pt)
)
)
)
)
)
ptLst
)
)
;;;Combines multiple Matrices into a single matrix
;;;(bldTformMatrix (list (ScaleMatrix 2) (TranslateMatrix '(2 2 0))))
(defun bldTformMatrix (matrixLst / TformMatrix)
(foreach matrix matrixLst
(setq TformMatrix
(if TformMatrix
(mxm TformMatrix matrix)
matrix
)
)
)
)
Here is another example using some of the same helper functions. This one allows you to create a selection set by defining a rectangular area that you can scale and rotate by moving the cursor.
Type "CS" at the command line to start it.
;;;Crazy Select!
(defun c:cs ()
(ax:cs rectangle1)
)
(defun ax:cs (shape / basePt rotation grInput
grRetVal sFac dragPnt vector matrix
pMatrix sMethod Color pColor ptLst
ss *error*
)
(defun *error* (msg)
(if (not
(member
Msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
)
(progn
(princ (strcat "\nError #" (itoa (getvar "ERRNO")) ": " Msg))
(setvar "ERRNO" 0)
)
)
;;erase last vectors
(if pMatrix
(grDrClosedShape pColor ptLst pMatrix)
)
(princ)
)
(if (setq basePt (getpoint "\nSelect point: "))
(progn
(setq sFac (/ (car (getvar "SCREENSIZE")) 1000)
vector (mapcar '- basePt)
ptLst (shape basePt)
grInput 5
)
;;Loop while user moves mouse
(while (= grInput 5)
(setq grRetVal (grread t 5 1)
grInput (car grRetVal)
dragPnt (cadr grRetVal)
rotation (angle basePt dragPnt)
sMethod (cond
((< (* 0.5 pi) rotation (* 1.5 pi))
"_CP"
)
(t "_WP")
)
color (if (equal sMethod "_WP") 300 -300)
matrix (bldTformMatrix
(list
(TranslateMatrix basePt)
(ScaleMatrix (/ (distance basePt dragpnt) sFac))
(TranslateMatrix Vector)
(TranslateMatrix basePt)
(RotateZMatrix rotation)
(TranslateMatrix Vector)
)
)
)
;;erase previous vectors
(if pMatrix
(grDrClosedShape pColor ptLst pMatrix)
)
;;Draw vectors
(grDrClosedShape Color ptLst Matrix)
;;Save current grvecs information
(setq pMatrix matrix
pColor Color
)
)
;;erase last vectors
(grDrClosedShape Color ptLst Matrix)
;;Transform points according to last matrix
(setq ss (ssget sMethod (transPts ptLst Matrix)))
)
(princ)
)
)
-
Here is some more cool stuff.
http://www.theswamp.org/forum/index.php?topic=7089.0
http://www.theswamp.org/forum/index.php?topic=7247.0
-
Thanks guys,
That sure gves me alot of things to digest. With everything that was posted I am sure I can learn something from all of this.
CAB, I have been checking out MP Ghosting routines to great extent, that is kinda what put me on this track of wanting to learn to draw to the drawing area.
Bobby, I like what you posted, It is actually more than what I was looking for, It scales and rotates :-o It will take me some time to digest it. If I have any question regarding this I'll be sure to post them in this thread.
Gary, Thanks for your take, that is where I am right now, I have a shape but now I want to rotate or scale it before it is stuck to the drawing area.
Uncoolperson, I believe you need to post your (Plus) function.
Thanks guys
-
Bobby,
Thanks for the routines. Very interesting.
I noted that in ACAD2000 there is a problem. I altered the color to 4 ILO 300
but still the rectangle is offset from the first pick point
The offset appears to be +1772 units on the x-axis.
all is fine in ACAD2004.
-
i keep on doing that
(DEFUN plus (v1 v2) (MAPCAR (FUNCTION +) v1 v2))
(it's not mine... i stole it)
-
Try this one.....and have fun.
Uses:
GRCLEAR
GRREAD
Gary