迴路LISP沒法用,求解

由 **winnie** 2023-08-30, 15:24

各位大大迴路lisp是前同事寫的,但他離職了,載入時沒法使用,求解

;====== Default ERROR function ================================
(defun *error* (/msg)
(if (= osflag 1)(setvar "osmode" osbak)(setvar "osmode" 0))
;(command "UCS" "W")
;(command "SNAP" "R" "0,0" 0 "SNAP" "OFF")
;(command "ERASE" "L" "")
(setvar "snapmode" 0)
(setvar "orthomode" oldortho)
(princ)
)
;====== Main program ==========================================
(defun ARRLIN1 ()
(menucmd "s=LINEPX")(menucmd "s=ARRSS1")(menucmd "s=*")
(setq arw (* arscale 8.0))
(setq arl (* arscale 24.0))
(setq wid (getvar "plinewid"))

(setq oldortho (getvar "orthomode"))
(setvar "orthomode" 0)
(setq loop "y")
(if (/= (getvar "osmode") 0)(setq osbak (getvar "osmode") osflag 1)(setq osflag 0))

(while (eq loop "y")

;------------------------ getpoint P1 --------------------- start --------
(setq p1 '(-1000.0 -1000.0 0.0))
(while (or (eq (car p1) -1000.0)(eq (cadr p1) -1000.0))

(if (eq osmode1 0)
(progn
(setvar "osmode" 0)
(princ "\n抓點模式 OSNAP 設為: <<< NONE >>>")
(princ)(princ "\n ")(princ)
) )
(if (eq osmode1 1)
(progn
(setvar "osmode" 512)
(princ "\n抓點模式 OSNAP 設為: <<< NEArest >>>")
(princ)(princ "\n ")(princ)
) )
(if (eq osmode1 2)
(progn
(setvar "osmode" 18)
(princ "\n抓點模式 OSNAP 設為: <<< MIDpoint & QUAdrant >>>")
(princ)(princ "\n ")(princ)
) )

(setq p1 (getpoint "\nstart point:"))
(if (or (eq (car p1) -1000.0)(eq (cadr p1) -1000.0))(if (eq osmode1 2)(setq osmode1 0)(if (eq osmode1 1)(setq osmode1 2)(setq osmode1 1))))
)
;------------------------ getpoint P1 ---------------------- end ---------

(if (eq p1 nil)(setq p1 p3))
(setvar "osmode" 0)
(setq p2 (getpoint "2nd point:" p1))
(command "PLINE" P1 "A" "S" P2 PAUSE "L" "W" arw "0" "L" arl "")
(setvar "plinewid" wid)
(setq arha (/ arh 20))

(command "INSERT" ITFORM p1 arha arha "0")
(setq clayer (getvar "clayer"))
(command "EXPLODE" "L" "CHANGE" "P" "" "P" "LA" clayer "")
(if (eq ITFORM "itform1")(command "CHANGE" "L" "" "" "" "" "" "" arn))
(command "MOVE" "P" "" "@" PAUSE)
(command "CHANGE" "L" "" "" "" "" "" "" arn)

(if (eq (substr arn 8 1) "-")(progn (setq arnA (substr arn 1 7))(setq arnB (atoi (substr arn 9)))))
(if (eq (substr arn 7 1) "-")(progn (setq arnA (substr arn 1 6))(setq arnB (atoi (substr arn 8)))))
(if (eq (substr arn 6 1) "-")(progn (setq arnA (substr arn 1 5))(setq arnB (atoi (substr arn 7)))))
(if (eq (substr arn 5 1) "-")(progn (setq arnA (substr arn 1 4))(setq arnB (atoi (substr arn 6)))))
(if (eq (substr arn 4 1) "-")(progn (setq arnA (substr arn 1 3))(setq arnB (atoi (substr arn 5)))))
(if (eq (substr arn 3 1) "-")(progn (setq arnA (substr arn 1 2))(setq arnB (atoi (substr arn 4)))))
(if (eq (substr arn 2 1) "-")(progn (setq arnA (substr arn 1 1))(setq arnB (atoi (substr arn 3)))))

(if (or (eq (substr arn 8 1) "-")(eq (substr arn 7 1) "-")(eq (substr arn 6 1) "-")(eq (substr arn 5 1) "-")(eq (substr arn 4 1) "-")(eq (substr arn 3 1) "-")(eq (substr arn 2 1) "-")(eq (substr arn 1 1) "-")
(eq ITFORM "itform2")(eq ITFORM "itform3")(eq ITFORM "itform4")(eq ITFORM "itform5")(eq ITFORM "itform6")(eq ITFORM "itform7")(eq ITFORM "itform8"))
(progn
(menucmd "s=ARRSSNN")
(menucmd "s=*")
)
(progn
(menucmd "s=ARRSSNN1")
(menucmd "s=*")
)
)

(princ "\n輸入字串,可用螢幕功能表,或ESC取消字串 <")(princ arn)(princ ">: ")(setq arn1 (getstring t))
(if (eq ITFORM "itform1")
(if (or (eq (substr arn1 1 1) "+")(eq (substr arn1 1 1) "-")) (setq arn (strcat arnA "-" (itoa (+ arnB (atoi arn1))))) (if (and (/= arn1 nil) (/= arn1 ""))(setq arn arn1)))
(if (and (/= arn1 "-6")(/= arn1 "-5")(/= arn1 "-4")(/= arn1 "-3")(/= arn1 "-2")(/= arn1 "-1")(/= arn1 "+1")(/= arn1 "+2")(/= arn1 "+3")(/= arn1 "+4")(/= arn1 "+5")(/= arn1 "+6"))
(setq arn arn1)
(setq arn (itoa (+ (atoi arn) (atoi arn1))))
)
)

(command "CHANGE" "L" "" "" "" "" "" "" arn)
(menucmd "s=LINEPX")
(menucmd "s=ARRSS1")
(menucmd "s=*")
(setq p3 p1)
)
)