[编程交流] 停车场错误：无功能

; PARK.LSP  Copyright 1989,90,91  Tony Tanzillo  All Rights Reserved.
;
; This program automates the layout of rows of right-angle parking spaces
; (or more accurately, the striping for parking spaces).  Great for site
; planning/layout work.  Automatically calculates the reqired stall width
; above a specified minimum, to fit the maximum number of stalls into the
; specified area.
;
; No further documentation available, just follow the prompts.
 (defun C:STALL90 ( / +pi/2 -pi/2 sc sw sl sxw st p1 p2 p3 p4 a d l hi bm)
     (setq +pi/2 '((a) (+ a (/ pi 2.0)))
           -pi/2 '((a) (- a (/ pi 2.0))))
     (initget 7)
     (setq sw (getdist "\nMinimum stall width: "))
     (setq sl (getdist "\nStall depth: "))
     (initget 1 "Single Double  Double")
     (setq st (getkword "Single- or Double-loaded <Double>: "))
     (initget 1 "Entity  Entity")
     (setq p1 (getpoint "\nFirst alignment point/<Entity>: "))
     (cond (  (eq p1 "Entity")
              (setq l (entsel "\nSelect line: "))
              (setq l (entget (car l)))
              (setq p1 (cdr (assoc 10 l))
                    p2 (cdr (assoc 11 l))))
           (t (setq p2 (getpoint p1 "\nSecond alignment point: "))))
     (cond (  (eq st "Single")
              (setq p3 (getpoint "\nWhich side of alignment: "))))
     (setq d (distance p1 p2))
     (setq a (angle p1 p2))
     (setq sc (fix (/ d sw)))
     (setq sxw (/ d sc))
     (if p3 (setq p4 (inters p1 p2 p3 (polar p3 (+pi/2 a) 1.0) nil)))
     (princ (strcat "\nDrawing "
                    (cond (p3 "") (t "2 x "))
                    (itoa sc) " stalls @ " (rtos sxw) " wide x "
                    (rtos sl) " deep."))
     (printf "\nDrawing ~i x ~i stalls @ ~d wide x ~d deep."
             (list n sc sxw sl))
     (setvar "cmdecho" 0)
     (setq hi (getvar "highlight"))
     (setq bm (getvar "blipmode"))
     (setvar "highlight" 0)
     (setvar "blipmode" 0)
     (command ".line" p1 p2 "")
     (cond (p3 (command ".line" p1 (polar p1 (angle p4 p3) sl) ""))
           (t  (command ".line" (polar p1 (+pi/2 a) sl)
                                (polar p1 (-pi/2 a) sl) "")))
     (command ".UCS" "Z" (* a (/ 180.0 pi))
              ".array" (entlast) "" "R" "1" (1+ sc) sxw
              ".UCS" "P"
     )
     (setvar "highlight" hi)
     (setvar "blipmode" bm)
     (princ)
 )
; --------------------------------eof park.lsp-------------------------

Command: (LOAD "S:/LISP/PARK.LSP") C:STALL90
Command: stall90
Minimum stall width: 5
Stall depth: 20
Single- or Double-loaded <Double>: single
First alignment point/<Entity>:
Second alignment point:
Which side of alignment:
Drawing 522 stalls @ 5" wide x 1'-8" deep.; error: no function definition: 
PRINTF

; PARK.LSP  Copyright 1989,90,91  Tony Tanzillo  All Rights Reserved.
;
; This program automates the layout of rows of right-angle parking spaces
; (or more accurately, the striping for parking spaces).  Great for site
; planning/layout work.  Automatically calculates the reqired stall width
; above a specified minimum, to fit the maximum number of stalls into the
; specified area.
;
; No further documentation available, just follow the prompts.
 (defun C:STALL90 ( / +pi/2 -pi/2 sc sw sl sxw st p1 p2 p3 p4 a d l hi bm)
     (setq +pi/2 '((a) (+ a (/ pi 2.0)))
           -pi/2 '((a) (- a (/ pi 2.0))))
     (initget 7)
     (setq sw (getdist "\nMinimum stall width: "))
     (setq sl (getdist "\nStall depth: "))
     (initget 1 "Single Double  Double")
     (setq st (getkword "Single- or Double-loaded <Double>: "))
     (initget 1 "Entity  Entity")
     (setq p1 (getpoint "\nFirst alignment point/<Entity>: "))
     (cond (  (eq p1 "Entity")
              (setq l (entsel "\nSelect line: "))
              (setq l (entget (car l)))
              (setq p1 (cdr (assoc 10 l))
                    p2 (cdr (assoc 11 l))))
           (t (setq p2 (getpoint p1 "\nSecond alignment point: "))))
     (cond (  (eq st "Single")
              (setq p3 (getpoint "\nWhich side of alignment: "))))
     (setq d (distance p1 p2))
     (setq a (angle p1 p2))
     (setq sc (fix (/ d sw)))
     (setq sxw (/ d sc))
     (if p3 (setq p4 (inters p1 p2 p3 (polar p3 (+pi/2 a) 1.0) nil)))
     (princ (strcat "\nDrawing "
                    (cond (p3 "") (t "2 x "))
                    (itoa sc) " stalls @ " (rtos sxw) " wide x "
                    (rtos sl) " deep."))
     ;(printf "\nDrawing ~i x ~i stalls @ ~d wide x ~d deep."
           ;  (list n sc sxw sl))
     (setvar "cmdecho" 0)
     (setq hi (getvar "highlight"))
     (setq bm (getvar "blipmode"))
     (setvar "highlight" 0)
     (setvar "blipmode" 0)
     (command ".line" p1 p2 "")
     (cond (p3 (command ".line" p1 (polar p1 (angle p4 p3) sl) ""))
           (t  (command ".line" (polar p1 (+pi/2 a) sl)
                                (polar p1 (-pi/2 a) sl) "")))
     (command ".UCS" "Z" (* a (/ 180.0 pi))
              ".array" (entlast) "" "R" "1" (1+ sc) sxw
              ".UCS" "P"
     )
     (setvar "highlight" hi)
     (setvar "blipmode" bm)
     (princ)
 )
; --------------------------------eof park.lsp-------------------------

; PARK.LSP  Copyright 1989,90,91  Tony Tanzillo  All Rights Reserved.
;
; This program automates the layout of rows of right-angle parking spaces
; (or more accurately, the striping for parking spaces).  Great for site
; planning/layout work.  Automatically calculates the reqired stall width
; above a specified minimum, to fit the maximum number of stalls into the
; specified area.
;
; No further documentation available, just follow the prompts.
; Modified by Lee Mac  ~  21.12.2009
(defun C:STALL90  (/ *error* lin +pi/2 -pi/2  A ALINE D DOC L OV P1
                                 P2 P3 P4 SC SL ST SW SXW UFLAG VL)
 (vl-load-com)
 (defun *error* (msg)
   (and ov (mapcar 'setvar vl ov))
   (and uflag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 (setq lin '((pt1 pt2) (entmakex (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2))))
       +pi/2 '((a) (+ a (/ pi 2.0)))
       -pi/2 '((a) (- a (/ pi 2.0))))
 
 (initget 7)
 (setq sw (getdist "\nMinimum stall width: "))
 
 (initget 7)
 (setq sl (getdist "\nStall depth: "))
 
 (initget "Single Double")
 (setq st (cond ((getkword "\nSingle- or Double-loaded <Double>: ")) ("Double")))
 
 (initget "Entity")
 (setq p1 (getpoint "\nFirst alignment point/<Entity>: "))
 
 (cond (  (or (not p1) (eq p1 "Entity"))
          (while
            (progn
              (setq l (car (entsel "\nSelect line: ")))
              (cond (  (eq 'ENAME (type l))
                       (if (not (eq "LINE" (cdr (assoc 0 (setq l (entget l))))))
                         (princ "\n** Object must be a Line **")))
                    (  (princ "\n** Nothing Selected **")))))
          (setq p1 (cdr (assoc 10 l)) p2 (cdr (assoc 11 l))))
       (t (setq p2 (getpoint p1 "\nSecond alignment point: "))))
 
 (cond (  (eq st "Single")
          (setq p3 (getpoint "\nWhich side of alignment: "))))
 
 (setq d (distance p1 p2) a (angle p1 p2) sc (fix (/ d sw)) sxw (/ d sc))
 
 (if p3 (setq p4 (inters p1 p2 p3 (polar p3 (+pi/2 a) 1.0) nil)))
 
 (princ (strcat "\nDrawing " (cond (p3 "") (t "2 x ")) (itoa sc)
                " stalls @ " (rtos sxw) " wide x " (rtos sl) " deep."))
 (setq vl '("CMDECHO" "HIGHLIGHT" "BLIPMODE") ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 0 0))
 (setq uFlag (not (vla-StartUndoMark
                    (setq doc (vla-get-ActiveDocument
                                (vlax-get-acad-object))))))
 (lin p1 p2)
 (setq aLine
   (cond (p3 (lin p1 (polar p1 (angle p4 p3) sl)))
         (t  (lin (polar p1 (+pi/2 a) sl) (polar p1 (-pi/2 a) sl)))))
 
 (command "_.UCS" "_Z" (* a (/ 180.0 pi)) "_.-array" aLine "" "_R" "1" (1+ sc) sxw "_.UCS" "_P")  
 (setq uFlag (vla-EndUndoMark doc))
 (mapcar 'setvar vl ov)
 (princ))