DOSLIB is required in the CHKKWDS subroutine. I have not attempted to include DOSLIB. You can get it from Robert McNeel & Associates for free here: https://wiki.mcneel.com/doslib/home
;;;Draws a pressure tank from centers or ends.
;;;Requires: Ukword.lsp, Upoint.lsp, Ureal.lsp
;;;
(defun c:ptank (/ pttyp pt1 pt2 pi00 pi90 pi180 pi270 hwid ptp1 ptp2
plp1 plp2 plp3 plp4)
(setq pttyp "End") ;(ukword 1 "Center End" "Place from Centers or Ends?" "End"))
(setvar "OSMODE" 1285)
(setvar "AUTOSNAP" 7)
(if upoint nil (load "upoint" "\nFile UPOINT.LSP not loaded!"))
(if ureal nil (load "ureal" "\nFile UREAL.LSP not loaded!"))
(while
(and (setq pt1 (upoint 0 "Quit" "First point of Pressure Tank [Quit]" nil nil))(/= pt1 "Quit"))
(progn
(setq
pt2 (upoint
1
"A-500 B-1000"
"Second point of Pressure Tank or [A-500 gal/B-1000 gal]"
nil
pt1
) ;_ end of upoint
) ;_ end of setq
(cond
((and (eq (type pt2) 'STR)(wcmatch pt2 "A-500"))
(setq ptdir (upoint
1
""
"Direction of 500 gallon Pressure Tank"
nil
pt1
) ;_ end of upoint
) ;_ end of setq
(setq pt2 (polar pt1 (angle pt1 ptdir) ptlen))
(setq ptlen (+ 9.0 (/ 11.0 12.0))
ptwid (/ 37.0 12.0)
) ;_ end of setq
)
((and (eq (type pt2) 'STR)(wcmatch pt2 "B-1000"))
(setq ptdir (upoint
1
""
"Direction of 1000 gallon Pressure Tank"
nil
pt1
) ;_ end of upoint
) ;_ end of setq
(setq pt2 (polar pt1 (angle pt1 ptdir) ptlen))
(setq ptlen 16.0
ptwid (/ 42.0 12.0)
) ;_ end of setq
)
(T
(setq ptwid (ureal 0 "" "Width of Pressure Tank" ptwd))
)
) ;_ end of cond
(setq pi00 (angle pt1 pt2)
pi180 (angle pt2 pt1)
pi90 (+ pi00 (* pi 0.5))
pi270 (+ pi00 (* pi 1.5))
hwid (* ptwid 0.5)
) ;setq
(if (eq pttyp "End")
(setq ptp1 (polar pt1 pi00 hwid)
ptp2 (polar pt2 pi180 hwid)
plp1 (polar ptp1 pi270 hwid)
plp2 (polar ptp2 pi270 hwid)
plp3 (polar ptp2 pi90 hwid)
plp4 (polar ptp1 pi90 hwid)
) ;setq
(setq pt1 (polar pt1 pi180 hwid)
pt2 (polar pt2 pi00 hwid)
ptp1 (polar pt1 pi00 hwid)
ptp2 (polar pt2 pi180 hwid)
plp1 (polar ptp1 pi270 hwid)
plp2 (polar ptp2 pi270 hwid)
plp3 (polar ptp2 pi90 hwid)
plp4 (polar ptp1 pi90 hwid)
) ;setq
) ;if
(setvar "osmode" 0)
(IF errortrap NIL (LOAD "errortrap" "\nFile ERRORTRAP.LSP not loaded! "))
(errortrap '(command ".pline" plp2 "a" "a" 180.0 (reverse (cdr (reverse (POLAR plp2 pi90 ptwid)))) "l" plp4 "a" plp1 "CL"))
(PRINC "\nDistance plp1 - plp2 = ")
(PRINC (distance plp1 plp2))
) ;progn
) ;while
) ;defun
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 0 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;
UPOINT.LSP
;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. This credit must accompany all copies of this function.
;;;October 19, 2004 added function to check keywords
;* UPOINT User interface point function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default point variable
;* is added as <DEF> (nil for none), and a : is added. BPT is base point
;* (nil for none).
;*
(defun upoint (bit kwd msg def bpt / inp)
(IF chkkwds nil (load "chkkwds" "\nFile CHKKWDS.LSP not loaded! "))
(chkkwds kwd)
(if def
(if (eq (type def) 'STR)
(setq msg (strcat "\n" msg " <" def ">:")
bit (* 2 (fix (/ bit 2)))
)
(progn
(setq pts (strcat
(rtos (car def)) "," (rtos (cadr def))
(if
(and (caddr def) (= 0 (getvar "FLATLAND")))
(strcat "," (rtos (caddr def)))
""
) );if&strcat
msg (strcat "\n" msg " <" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
)
)
(setq msg (strcat "\n" msg ": "))
);if a default was supplied
(initget bit kwd)
(setq inp
(if bpt
(getpoint msg bpt)
(getpoint msg)
) );setq&if
(if inp inp def)
);defun
;*
(princ)
;*
UKWORD
;;; This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New
;;; Riders Publications. This credit must accompany all copies of this
;;; function.
;;;October 19, 2004 added function chkkwds (see description at end of file)
;;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;;* for INITGET. MSG is the prompt string, to which a default string is added
;;;* as <DEF> (nil or "" for none), and a : is added.
;;;*
(DEFUN ukword (bit kwd msg def / inp)
(IF chkkwds nil (load "chkkwds" "\nFile CHKKWDS.LSP not loaded! "))
(chkkwds kwd)
(IF (AND def (/= def ""))
(SETQ msg (STRCAT "\n" msg " <" def ">: ")
bit (* 2 (FIX (/ bit 2)))
);setq
);if
(INITGET bit new-kwd)
(SETQ inp (GETKWORD msg))
(IF inp
inp
def
) ;_ end of if
);defun
;*
(PRINC)
;*
UREAL
;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. This credit must accompany all copies of this function.
;;;October 19, 2004 added function chkkwds (see description at end of file)
;* UREAL User interface real function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun ureal (bit kwd msg def / inp)
(IF chkkwds nil (load "chkkwds" "\nFile CHKKWDS.LSP not loaded! "))
(chkkwds kwd)
(if def
(setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL)(rtos def 2)(if (eq (type def) 'INT)(itoa def)def)) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
);defun
;*
(princ)
;*
CHKKWDS
(DEFUN chkkwds (kwd /)
(SETQ invalidcharlst (LIST "!" "@" "$" "%" "^" "#" "`" "(" ")" "*" "=" "<" ">" "_"));"&" "+" "_"
(SETQ kwd-list (DOS_STRTOKENS kwd " ")
new-kwd NIL
stripped-kwd NIL
)
(FOREACH q kwd-list
(IF (WCMATCH q "*`!*,*`@*,*`$*,*`%*,*`^*,*`#*,*`**,*(*,*)*,*=*,*<*,*>*,*`_*")
(IF stripped-kwd
(SETQ stripped-kwd (STRCAT stripped-kwd ", " q))
(SETQ stripped-kwd q)
)
(IF new-kwd
(SETQ new-kwd (STRCAT new-kwd " " q))
(SETQ new-kwd q)
)
)
)
(SETQ kwd new-kwd)
(IF stripped-kwd
(PROGN
(IF (WCMATCH stripped-kwd "*`,*")
(PRINC "\nThese linetypes were removed because their names are invalid as a keyword: ")
(PRINC "\nThis linetype was removed because its name is invalid as a keyword: ")
)
(PRINC stripped-kwd)
(PRINC "\n")
(PRINC)
)
)
)
AutoCAD User since 1989. Civil Engineering Professional since 1983
Product Version: 13.6.1963.0 Civil 3D 2024.4.1 Update Built on: U.202.0.0 AutoCAD 2024.1.6
27.0.37.14 Autodesk AutoCAD Map 3D 2024.0.1
8.6.52.0 AutoCAD Architecture 2024