[求助]：谁能帮我看看这lisp问题出在哪?

rodger888

谁能帮我看看附件里这个lisp问题出在哪?为什么不能运行?请帮我修改一下,谢谢了!

它山之石

文件无法下载
把程序贴出来吧

rodger888

好的．
(defun DCL_INIT_LOGO (/ X Y)
  (setq        X (dimx_tile "PISA-LOGO")
        Y (dimy_tile "PISA-LOGO")
  )
  (setq DCL_IMG "PISA-NEW.sld")
  (start_image "PISA-LOGO")
  (slide_image 0 0 X Y DCL_IMG)
  (end_image)
)
(defun SUBJOB (VVS)
  (setq JOBN (nth (atoi VVS) JOB-LIST))
  (cond        ((= "1" (get_tile "SF_SHOP"))
         (setq DWGPATH (dos_getini JOBN "SHOP" SF-FILE))
         (set_tile "SF_ERR" DWGPATH)
        )
        ((= "1" (get_tile "SF_FAB"))
         (setq DWGPATH (dos_getini JOBN "FAB" SF-FILE))
         (set_tile "SF_ERR" DWGPATH)
        )
        (t (set_tile "SF_ERR" JOBN))
  )
)
(defun SUBSHOP ()
  (setq DWGPATH (dos_getini JOBN "SHOP" SF-FILE)
        DWGTYPE "SHOP")
  (set_tile "SF_ERR" DWGPATH)
)
(defun SUBFAB ()
  (setq DWGPATH (dos_getini JOBN "FAB" SF-FILE)
        DWGTYPE "FAB")
  (set_tile "SF_ERR" DWGPATH)
)
(defun chkdef(JOB-LIST / finddef j-pos d-type)
  (setq finddef (findfile "PISATOOLS.INI"))
  (COND
    ((/= NIL FINDDEF)
      (setq j-pos (vl-position (dos_getini "SHOPFAB" "JOBN" FINDDEF) JOB-LIST))
      (setq d-type (dos_getini "SHOPFAB" "DTYPE" FINDDEF))
      (setq d-name (dos_getini "SHOPFAB" "DNAME" FINDDEF))
      (if (/= "" j-pos) (set_tile "SF_JOB" (RTOS j-pos 2 0)))
      (if (/= "" d-name) (set_tile "SF_DWG" d-name))
      (COND ((= d-type "FAB") (set_tile "SF_FAB" "1"))
            ((= d-type "SHOP") (set_tile "SF_SHOP" "1"))
            ))
    (T (setq JOBN (NTH 0 JOB-LIST))
       (set_tile "SF_JOB" "0")
       (set_tile "SF_SHOP" "1")
     )
    )
  )
(defun MAKEDEF (/ M-PATH M-FILE)
  (setq        M-PATH (substr (findfile "ACAD.EXE")
                       1
                       (- (strlen (findfile "ACAD.EXE")) 8)
               )
  )
  (SETQ M-FILE (STRCAT M-PATH "PISATOOLS.INI"))
  (DOS_SETINI "SHOPFAB" "JOBN" JOBN M-FILE)
  (DOS_SETINI "SHOPFAB" "DTYPE" DWGTYPE M-FILE)
  (DOS_SETINI "SHOPFAB" "DNAME" DWGNO M-FILE)
  (SF_OPEN DWGPATH DWGNO)
  )
(defun DCL_SHOPFAB (/ SF-FILE)
  (setq DCL_ID (load_dialog "SHOPFAB.DCL"))
  (new_dialog "SF_FILE" DCL_ID)
  (DCL_INIT_LOGO)
  (setq SF-FILE (findfile "sf_path.ini"))
  (setq JOB-LIST (dos_getini NIL NIL SF-FILE))
  (start_list "SF_JOB")
  (mapcar 'add_list JOB-LIST)
  (end_list)
  (action_tile "SF_JOB" "(subjob $value)")
  (action_tile "SF_SHOP" "(subshop)")
  (action_tile "SF_FAB" "(subfab)")
  (action_tile "SF_DWG" "(setq DWGNO $value)")
  (action_tile "accept" "(done_dialog 1)(makedef)")
  (CHKDEF JOB-LIST)
  (start_dialog)
)
;;;OPENDWG---------------------------------------------------------------------------
(defun opendwg (dwg / readonly)
  (if (dos_openp dwg)
    (progn
      (setq dwl2 (strcat (substr dwg 1 (- (strlen dwg) 4)) ".dwl"))
      (setq dwl        (if (findfile dwl2)
                  (open dwl2 "r")
                )
      )
      (setq who        (strcat        (read-line dwl)
                        " , "
                        (read-line dwl)
                        ". Since: "
                        (read-line dwl)
                )
      )
      (close dwl)
      (setq readonly
             (acet-ui-message
               (strcat dwg
                       " is currently in use by :\n"
                       who
                       "\nwould you like to open the file read-only?"
               )
               "AutoCAD Alert"
               20
             )
      )
    )
  )
  (if (= nil readonly)
    (setq readonly 6)
  )
  (if (= readonly 6)
    (command "vbastmt"
             (strcat "thisdrawing.application"
                     ".documents.open \""
                     dwg
                     "\""
             )
    )
  )
  (princ)
)
(defun FINDDWG (DWGNO FINDDIR)
  (DOS_FIND (STRCAT FINDDIR DWGNO ".DWG"))
  )

(defun OPENFOUND (HAVEFOUND FINDDIR / BLK)
  (if (/= NIL HAVEFOUND)
    (if        (= 1 (length HAVEFOUND))
      (OPENDWG (car HAVEFOUND))
      (OPENDWG (dos_listbox
                 "Select Dwg to open:"
                 "Found Dwg:"
                 (acad_strlsort HAVEFOUND)
               )
      )
    )
    (progn (setq FINDDIR (FOLDERBROWSE "Select Directory Please" FINDDIR)
                 BLK         (dos_dwgpreview DWGNO FINDDIR)
           )
           (if (/= NIL BLK)
             (OPENDWG BLK)
           )
    )
  )
)
(defun FOLDERBROWSE (MSG DPATH / OBJ FOLDER PATH)
  (vl-load-com)
  (setq OBJ (vlax-create-object "Shell.Application"))
  (setq FOLDER (vlax-invoke-method OBJ 'BROWSEFORFOLDER 0 MSG 1 DPATH))
  (if (vl-catch-all-error-p
        (setq PATH (vl-catch-all-apply
                     '(lambda ()
                        (vlax-get-property
                          (vlax-get-property FOLDER 'SELF)
                          'PATH
                        )
                      )
                   )
        )
      )
    NIL
    PATH
  )
)
(defun SF_OPEN (DWGPATH DWGNO / DWG2OP)
  (vl-propagate 'DWGNO)
  (if (/= NIL (setq DWG2OP (FINDDWG DWGNO DWGPATH)))
    (OPENFOUND DWG2OP DWGPATH)
  )
)




(defun C:SF () (DCL_SHOPFAB))

zml84

要判读他人的源代码，却非易事。尤其没有丝毫注释的。
为便于阅读，整理后贴于后。
[PHP]
(defun DCL_INIT_LOGO (/ X Y)
  (setq        X (dimx_tile "PISA-LOGO")
        Y (dimy_tile "PISA-LOGO")

  )
  (setq DCL_IMG "PISA-NEW.sld")
  (start_image "PISA-LOGO")
  (slide_image 0 0 X Y DCL_IMG)
  (end_image)
)

(defun SUBJOB (VVS)
  (setq JOBN (nth (atoi VVS) JOB-LIST))
  (cond        ((= "1" (get_tile "SF_SHOP"))
         (setq DWGPATH (dos_getini JOBN "SHOP" SF-FILE))
         (set_tile "SF_ERR" DWGPATH)
        )

        ((= "1" (get_tile "SF_FAB"))
         (setq DWGPATH (dos_getini JOBN "FAB" SF-FILE))
         (set_tile "SF_ERR" DWGPATH)
        )
        (t (set_tile "SF_ERR" JOBN))
  )

)
(defun SUBSHOP ()
  (setq DWGPATH (dos_getini JOBN "SHOP" SF-FILE)
        DWGTYPE "SHOP")
  (set_tile "SF_ERR" DWGPATH)
)
(defun SUBFAB ()

  (setq DWGPATH (dos_getini JOBN "FAB" SF-FILE)
        DWGTYPE "FAB")
  (set_tile "SF_ERR" DWGPATH)
)
(defun chkdef(JOB-LIST / finddef j-pos d-type)
  (setq finddef (findfile "PISATOOLS.INI"))
  (COND

    ((/= NIL FINDDEF)
      (setq j-pos (vl-position (dos_getini "SHOPFAB" "JOBN" FINDDEF) JOB-LIST))
      (setq d-type (dos_getini "SHOPFAB" "DTYPE" FINDDEF))
      (setq d-name (dos_getini "SHOPFAB" "DNAME" FINDDEF))
      (if (/= "" j-pos) (set_tile "SF_JOB" (RTOS j-pos 2 0)))
      (if (/= "" d-name) (set_tile "SF_DWG" d-name))

      (COND ((= d-type "FAB") (set_tile "SF_FAB" "1"))
            ((= d-type "SHOP") (set_tile "SF_SHOP" "1"))
            ))
    (T (setq JOBN (NTH 0 JOB-LIST))
       (set_tile "SF_JOB" "0")
       (set_tile "SF_SHOP" "1")

     )
    )
  )
(defun MAKEDEF (/ M-PATH M-FILE)
  (setq        M-PATH (substr (findfile "ACAD.EXE")
                       1

                       (- (strlen (findfile "ACAD.EXE")) 8)
               )
  )
  (SETQ M-FILE (STRCAT M-PATH "PISATOOLS.INI"))
  (DOS_SETINI "SHOPFAB" "JOBN" JOBN M-FILE)
  (DOS_SETINI "SHOPFAB" "DTYPE" DWGTYPE M-FILE)

  (DOS_SETINI "SHOPFAB" "DNAME" DWGNO M-FILE)
  (SF_OPEN DWGPATH DWGNO)
  )
(defun DCL_SHOPFAB (/ SF-FILE)
  (setq DCL_ID (load_dialog "SHOPFAB.DCL"))
  (new_dialog "SF_FILE" DCL_ID)

  (DCL_INIT_LOGO)
  (setq SF-FILE (findfile "sf_path.ini"))
  (setq JOB-LIST (dos_getini NIL NIL SF-FILE))
  (start_list "SF_JOB")
  (mapcar 'add_list JOB-LIST)
  (end_list)

  (action_tile "SF_JOB" "(subjob $value)")
  (action_tile "SF_SHOP" "(subshop)")
  (action_tile "SF_FAB" "(subfab)")
  (action_tile "SF_DWG" "(setq DWGNO $value)")
  (action_tile "accept" "(done_dialog 1)(makedef)")
  (CHKDEF JOB-LIST)

  (start_dialog)
)
;;;OPENDWG---------------------------------------------------------------------------
(defun opendwg (dwg / readonly)
  (if (dos_openp dwg)
    (progn
      (setq dwl2 (strcat (substr dwg 1 (- (strlen dwg) 4)) ".dwl"))

      (setq dwl        (if (findfile dwl2)
                  (open dwl2 "r")
                )
      )
      (setq who        (strcat        (read-line dwl)
                        " , "

                        (read-line dwl)
                        ". Since: "
                        (read-line dwl)
                )
      )
      (close dwl)

      (setq readonly
             (acet-ui-message
               (strcat dwg
                       " is currently in use by :\n"
                       who
                       "\nwould you like to open the file read-only?"

               )
               "AutoCAD Alert"
               20
             )
      )
    )

  )
  (if (= nil readonly)
    (setq readonly 6)
  )
  (if (= readonly 6)
    (command "vbastmt"

             (strcat "thisdrawing.application"
                     ".documents.open \""
                     dwg
                     "\""
             )
    )

  )
  (princ)
)
(defun FINDDWG (DWGNO FINDDIR)
  (DOS_FIND (STRCAT FINDDIR DWGNO ".DWG"))
  )


(defun OPENFOUND (HAVEFOUND FINDDIR / BLK)
  (if (/= NIL HAVEFOUND)
    (if        (= 1 (length HAVEFOUND))
      (OPENDWG (car HAVEFOUND))
      (OPENDWG (dos_listbox
                 "Select Dwg to open:"

                 "Found Dwg:"
                 (acad_strlsort HAVEFOUND)
               )
      )
    )
    (progn (setq FINDDIR (FOLDERBROWSE "Select Directory Please" FINDDIR)

                 BLK         (dos_dwgpreview DWGNO FINDDIR)
           )
           (if (/= NIL BLK)
             (OPENDWG BLK)
           )
    )

  )
)
(defun FOLDERBROWSE (MSG DPATH / OBJ FOLDER PATH)
  (vl-load-com)
  (setq OBJ (vlax-create-object "Shell.Application"))
  (setq FOLDER (vlax-invoke-method OBJ 'BROWSEFORFOLDER 0 MSG 1 DPATH))
  (if (vl-catch-all-error-p

        (setq PATH (vl-catch-all-apply
                     '(lambda ()
                        (vlax-get-property
                          (vlax-get-property FOLDER 'SELF)
                          'PATH
                        )

                      )
                   )
        )
      )
    NIL
    PATH

  )
)
(defun SF_OPEN (DWGPATH DWGNO / DWG2OP)
  (vl-propagate 'DWGNO)
  (if (/= NIL (setq DWG2OP (FINDDWG DWGNO DWGPATH)))
    (OPENFOUND DWG2OP DWGPATH)
  )

)

(defun C:SF () (DCL_SHOPFAB))
[/PHP]