uhcafigdc 发表于 2022-7-6 11:59:49

停车场错误:无功能

含糖的公园lsp生成90度停车位:
 
; PARK.LSPCopyright 1989,90,91Tony TanzilloAll 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 DoubleDouble")
   (setq st (getkword "Single- or Double-loaded <Double>: "))
   (initget 1 "EntityEntity")
   (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-------------------------

 
不过,它不起作用。我已经在AutoCAD 2007 ADT和BricsCAD Classic v9上试用过。两者给出的错误消息大致相同:
 
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

Lee Mac 发表于 2022-7-6 12:18:48

哈哈,代码里有点C。。。
 
快速模式:
 

; PARK.LSPCopyright 1989,90,91Tony TanzilloAll 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 DoubleDouble")
   (setq st (getkword "Single- or Double-loaded <Double>: "))
   (initget 1 "EntityEntity")
   (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-------------------------

uhcafigdc 发表于 2022-7-6 12:31:35

李,你修好了!

Lee Mac 发表于 2022-7-6 12:38:15

没有问题
 
这可能更快:
 

; PARK.LSPCopyright 1989,90,91Tony TanzilloAll 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/2A 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))

LEsq 发表于 2022-7-6 12:52:51

我打赌它可以更新,以更好地工作,并适应创造双档停车场。。。
 
这是前一段时间做的事情。。。看看是否有帮助或提供了新的想法。
部分。lsp

Lee Mac 发表于 2022-7-6 12:59:58

很好,路易斯
页: [1]
查看完整版本: 停车场错误:无功能