; New Solid functions by Terry Rawkins
; TRawkins@netscape.net Monday, October 08, 2001
; all DOT- are now c:DOT- 8/10/01
;
(command "ucs" "W")
(command "osnap" "none")
(command "delobj" "1")
; .......................... New AutoCAD commands ....................
(defun C:SUB-PN ()
(setq pos (ssget "X" '((8 . "positive"))))
(setq neg (ssget "X" '((8 . "negative"))))
(command "subtract" pos "" neg "")
)
(defun C:UNI-POS ()
(setq pos (ssget "X" '((8 . "positive"))))
(command "union" pos "")
)
(defun C:UNI-NEG ()
(setq neg (ssget "X" '((8 . "negative"))))
(command "union" neg "")
)
(defun C:UNI-C ()
(setq
clay (getvar "clayer")
ss1 (ssget "X" (list (cons 8 clay )))
)
(command "union" ss1 "")
)
(defun C:LAYER-POS ()
(command "layer" "m" "Positive" "")
(command "layer" "color" "red" "positive" "")
)
(defun C:LAYER-NEG ()
(command "layer" "m" "negative" "")
(command "layer" "color" "yellow" "negative" "")
)
(defun C:ISO ()
(command "vpoint" "-1,-1,1")
)
; .......................... New Lisp Functions ....................
(defun SAVE-L (name /)
(setq ss1 (ssget "L"))
(command "wblock" name "Yes" "" "0,0" ss1 "")
)
(defun UCS-MOVE (x y z /)
(setq pt1 (list x y z ))
(command "ucs" "Move" pt1)
)
(defun C:DOT-F ()
(command "ucs" "w")
(command "ucs" "x" "90")
)
(defun C:DOT-B ()
(command "ucs" "w")
(command "ucs" "x" "90")
(command "ucs" "y" "180")
)
(defun C:DOT-L ()
(command "ucs" "w")
(command "ucs" "x" "90")
(command "ucs" "y" "-90")
)
(defun C:DOT-R ()
(command "ucs" "w")
(command "ucs" "x" "90")
(command "ucs" "y" "90")
)
(defun OUTLINE (x1 y1 x2 y2)
(setq clay (getvar "clayer")
ll (list x1 y1)
ur (list x2 y2)
pt1 (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0))
)
(command "layer" "m" "temp" "")
(command "boundary" pt1 "")
(setq ss1 (ssget "C" ll ur))
(command "erase" ss1 "R" "last" "")
(setq tempobj (ssget "X" '((8 . "temp"))))
(command "change" tempobj "" "P" "LA" clay "")
(command "layer" "s" clay "")
)
(defun PAL (x y num /)
(setq cen (list x y))
(command "array" "last" "" "polar" cen num "360" "yes")
)
(defun ROW (num dist /)
(command "array" "last" "" "R" "1" num Dist)
)
(defun COL (num dist /)
(command "array" "last" "" "R" num "1" Dist)
)
(defun INS (x y z name ang /)
(setq name (strcat "*" name)
pt1 (list x y z)
)
(command "insert" name pt1 "1" ang)
)
(defun EXTL (height ang /)
(command "extrude" "last" "" height ang)
)
(defun FRAME (x y x_dim Y_dim /)
(setq
ss1 (ssget "L")
pt1 (list x y)
pt2 (list (+ x (/ x_dim 2.0)) y)
pt3 (list (+ x (/ x_dim 2.0)) (+ y y_dim))
pt4 (list (- x (/ x_dim 2.0)) (+ y y_dim))
pt5 (list (- x (/ x_dim 2.0)) y)
)
(command "ucs" "y" "90" )
(command "pline" pt1 pt2 pt3 pt4 pt5 pt1 "")
(command "extrude" ss1 "" "P" "last")
(command "ucs" "p")
)
(defun SLOT ( x y lenth rad depth ang /)
(setq pt1 (list x (- y rad))
pt2 (list (+ x lenth) (- y rad))
pt3 (list (+ x lenth) (+ y rad))
pt4 (list x (+ y rad))
)
(command "pline" pt1 pt2 "arc" "ang" "180" pt3 "line" pt4 "arc" "ang" "180" pt1 "close")
(command "extrude" "last" "" (* -1.0 depth) ang)
)
(defun HOLLOW (x y wall extout /)
(setq one (ssget "L")
pick (list x y)
pt3 (list 0 0 0)
pt4 (list 0 0 wall)
extin (- extout (* 2 wall))
)
(command "offset" wall one pick "")
(command "move" "last" "" pt3 pt4)
(command "layer" "m" "negative" "")
(command "extrude" "last" "" extin "0")
(command "layer" "m" "positive" "")
(command "extrude" one "" extout "0")
(setq pos (ssget "X" '((8 . "positive"))))
(setq neg (ssget "X" '((8 . "negative"))))
(command "subtract" pos "" neg "")
)
(defun WALL (x y wall height /)
(setq one (ssget "L")
pick (list x y)
)
(command "offset" wall one pick "")
(command "layer" "m" "negative" "")
(command "extrude" "last" "" height "0")
(command "layer" "m" "positive" "")
(command "extrude" one "" height "0")
(setq pos (ssget "X" '((8 . "positive"))))
(setq neg (ssget "X" '((8 . "negative"))))
(command "subtract" pos "" neg "")
)
(defun WINDOW (x y width height wall /)
(command "layer" "m" "negative" "")
(command "BOX" (list x y wall) (list (+ x width) (+ y height) (* wall -1.0)))
(setq pos (ssget "X" '((8 . "positive"))))
(setq neg (ssget "X" '((8 . "negative"))))
(command "subtract" pos "" neg "")
)
; Coil a lisp program to draw a wire coil or spring by Terry Rawkins
; E-mail TRawkins@netscape.net
; Sunday, August 26, 2001
;
(defun COIL (x y z dia pitch num wire layer)
(setq
clay (getvar "clayer") ; remember current layer
ppr 20.0 ; points per rev
cen (list x y z) ; centre of rotation
rad (/ dia 2.0) ; radius of coil
stp (list (+ x rad) y z) ; start point
ang 0 ; initial angle
zz z ; variable z
a_inc (/ (* 2 pi) ppr) ; ang increment
v_inc (/ pitch ppr) ; vertical increment
w_cen (list (+ x rad) z (* y -1.0)) ; wire centre
fin (list (+ x rad) y (+ z (* num pitch))) ; final point
)
(command "layer" "m" layer "")
(command "3dpoly" stp)
(repeat (* num (fix ppr))
(setq 2d_pt (polar cen ang rad)
3d_pt (list (car 2d_pt) (cadr 2d_pt) zz)
ang (+ ang a_inc)
zz (+ zz v_inc)
)
(command 3d_pt)
); end of repeat
(command fin "")
(command "ucs" "x" "90")
(command "circle" w_cen "D" wire)
(command "extrude" "last" "" "P" w_cen )
(command "ucs" "p")
(command "layer" "s" clay "")
); end of coil
; a lisp prog to draw a 2D gear by Terry Rawkins
; From original code in cad user
; E-mail TRawkins@netscape.net
; Saturday, August 25, 2001
(defun GEAR (cx cy pcd n)
(command "ucs" "move" (list cx cy) )
(setq clay (getvar "clayer") )
(command "layer" "m" "gear" "")
(command "vpoint" "0,0,1")
(command "zoom" "w" (list (- 0 pcd) (- 0 pcd)) (list (+ 0 pcd) (+ 0 pcd)) )
(setq pcr (/ pcd 2.0)) (terpri)
(setq bcr (* pcr 0.9397))
(setq mod (/ (* pcr 2) n))
(setq orad (+ pcr mod))
(setq sq (sqrt (- (* orad orad) (* bcr bcr))))
(setq a (/ sq bcr))
(setq a1 (/ a 15))
(setq l "t")
(setq p0 (list 0 0))
(setq p1 (list 0 (+ 0 bcr) ))
(command "pline" p1)
(while l
(setq l (* bcr a1))
(setq x (- (* bcr (sin a1))(* l (cos a1))))
(setq y (+ (* bcr (cos a1))(* l (sin a1))))
(setq p2 (list x y ))
(command p2 )
(setq a1 (+ a1 (/ a 15)))
; (setq p1 p2)
(if (> a1 a) (setq l nil))
)
(command "")
(setq sq1 (sqrt (- (* pcr pcr)(* bcr bcr))))
(setq a2 (/ sq1 bcr))
(setq l (* bcr a2))
(setq x (- (* bcr (sin a2))(* l (cos a2))))
(setq y (+ (* bcr (cos a2))(* l (sin a2))))
(setq p6 (list x y))
(setq a6 (angle p0 p6))
(setq a7 (- (* 0.5 pi) a6))
(setq a8 (+ a7 (/ (* 0.5 pi) n)))
(setq a9 (- (* 0.5 pi) a8))
(setq p3 (polar p0 a9 orad))
; (command "arc" p3 "e" p2 "r" orad)
(setq rrad (- pcr (* 1.25 mod)))
(setq p4 (list 0 rrad))
(setq p1 (list 0 bcr))
(command "line" p1 p4 "")
(setq a10 (- (/ pi n) a8))
(setq a11 (+ a10 (* 0.5 pi)))
(setq p5 (polar p0 a11 rrad))
(command "arc" p4 "e" p5 "r" rrad)
(setq tooth (ssget "X" '((8 . "gear"))))
(command "mirror" tooth "" p3 p0 "no")
(setq tooth (ssget "X" '((8 . "gear"))))
(command "array" tooth "" "p" (list 0 0) n "360" "yes")
(setq orad (distance P0 P2))
(command "circle" p0 orad)
(command "layer" "S" clay "")
(command "boundary" p0 "")
(setq tooth (ssget "X" '((8 . "gear"))))
(command "erase" tooth "")
(command "ucs" "P")
); end of gear
;;;***************************************************************************************
;-------------------------------------------------------------------
; THREAD.LSP Creates 3D solid (ACIS) threads. 3/3/98
;
; Corrected 3/4/98
; Corrected again 3/6/98
; TPI input changed to pitch Terry Rawkins 30 March 2000
; Modified to be a lisp function 15/04/01 Terry Rawkins
; Email TRawkins@netscape.net
;
; written by: Jim Fitzgerald
;
; Credit goes to Bernd Hoffmann and Ken Shearron for showing
; me this modeling technique and helping me spot
; some bugs.
;
;-------------------------------------------------------------------
;
; This is a way to make 3D solid external threads in
; AutoCAD R13 and R14. Just so you know, it's not
; geometrically correct, but it's pretty darn close.
; There is no error trapping or anything like that.
;
; You are prompted for the X & Y of start point, Nominal thread size
; (actual size like .190 or .112, not #10, #4, etc..),
; pitch of the thread, the total length of the thread.
;
;The program works by creating a single thread
; and then arraying it out to the proper length. The threads are
; drawn a little long and then sliced off to the correct length.
; This program only draws the thread, you're on your own drawing
; the rest of the screw. For internal threads, just subtract this from
; another solid.
;
; Note, the threads created by this can make for some rather big files,
; so make sure your system is up to it. Also, it might take a while
; to union all of the single threads together so be patient.
;
;-------------------------------------------------------------------
; This is freeware. Do what you want with it. If you modify it,
; please take my name off of it so I don't have to support your
; software.
;
; All the typical legal stuff applies. I make no claims that
; this actually works. Use it at your own risk. You can't sue me
; for any problems that you have as a result of using this
; (either personal or professional). Don't drink and
; drive. Eat your vegetables, and call your mother.
;-------------------------------------------------------------------
(defun thread (x y nom pitch length / total pt1 pt1z pt2 pt3 ang pt1a
pt1az pt3a pt1b pt1bz pt3b pt4 pt4 pt6 pt7 pt8 pt9 pt10 pt11 pt12 ss
osm)
;-------------------------------------------------------------------
; Gets the nominal size, tpi, and total length
; then calculates a bunch of geometry points.
; All running osnaps are turned off as well.
;-------------------------------------------------------------------
(setq
cpt (list x y)
total (+ (fix (/ length pitch)) 2)
pt1 (list (- (car cpt) (/ nom 2.0)) (cadr cpt))
pt1z (list (- (car cpt) (/ nom 2.0)) (cadr cpt) 1.0)
pt2 (polar pt1 (/ (* 30.0 pi) 180.0) 0.1)
pt3 (list (+ (car pt1) nom) (+ (cadr pt1) (/ pitch 2.0)))
ang (angle pt1 pt3)
pt1a (polar pt1 (+ ang (/ pi 2.0)) pitch)
pt1az (list (car pt1a) (cadr pt1a) 1.0)
pt3a (polar pt1a ang nom)
pt1b (polar pt1 (- ang (/ pi 2.0)) pitch)
pt1bz (list (car pt1b) (cadr pt1b) 1.0)
pt3b (polar pt1b ang nom)
pt4 (polar pt3 (/ (* 150.0 pi) 180.0) 0.1)
pt5 (inters pt1 pt2 pt3 pt4 nil)
pt6 (list (car pt5) (cadr cpt))
pt7 (polar pt1 (/ (* 330.0 pi) 180.0) 0.1)
pt8 (polar pt3 (/ (* 210.0 pi) 180.0) 0.1)
pt9 (inters pt1 pt7 pt3 pt8 nil)
pt10 (list (car pt9) (cadr pt3))
pt11 (polar cpt (/ pi 2.0) pitch)
pt12 (polar pt11 (/ pi 2.0) length)
osm (getvar "osmode")
)
(setvar "osmode" 0)
;-------------------------------------------------------------------
; Draws two cones which are inverted and offset 1/2 the pitch.
; The cones are each sliced at the angle of the crest line
; and then unioned together
;-------------------------------------------------------------------
(princ "\nCreating thread...this might take a while.")
(command "pline" pt1 pt5 pt6 "c")
(command "revolve" "l" "" pt5 pt6 "")
(command "slice" "l" "" pt1 pt3 pt1z pt5)
(command "slice" "l" "" pt1a pt3a pt1az pt3)
(setq ss (ssadd (entlast)))
(command "pline" pt3 pt9 pt10 "c")
(command "revolve" "l" "" pt9 pt10 "")
(command "slice" "l" "" pt1 pt3 pt1z pt9)
(command "slice" "l" "" pt1b pt3b pt1bz pt3)
(setq ss (ssadd (entlast) ss))
(command "union" ss "")
;-------------------------------------------------------------------
; This above solid is sliced in half and then mirrored. This
; creates the "helix" in the thread. The height of the single
; thread is actually equal to twice the pitch, but the
; excess is either absorbed or cut off in the last step
;-------------------------------------------------------------------
(command "slice" ss "" "xy" cpt "b")
(setq ss (ssadd (entlast) ss))
(command "mirror" "l" "" pt1 "@10<0" "y")
(command "union" ss "")
;-------------------------------------------------------------------
; The thread is arrayed and then unioned together (this part can
; take a while). The resulting solid is cut to the specified length.
;-------------------------------------------------------------------
(setq e (entlast))
(command "array" ss "" "r" total 1 pitch)
(repeat (1- total)
(setq e (entnext e)
ss (ssadd e ss)
)
)
(princ "\nDone")
(setvar "osmode" osm)
(princ)
)
;;;****************************************************************************
; end of file
(
geocities.com/wpsmoke/acadscripts) (
geocities.com/wpsmoke)