[其他]：[參考]圖庫管理

spring1983

下面這個程序我發了10天的時間寫的(存在很多錯誤),最近公司比較忙,等有空在來理它.
基本功能應該有了.呵呵.

spring1983

jpg

spring1983

;;;功能:圖庫管理
;;;BY Spring
;;;08/20-03
;;;_______________________________________________________
(defun ICON_NA (/ count iconname_list)
  (setq count 0)
  (while (/= count 16)
    (setq iconname_list (nth count icon_list))
    (princ "\n")
    (princ iconname_list)
    (setq count (1+ count))
  )
)
;;;_______________________________________________________
(defun PREV_LOUN ()
  (if (>= n? 16)
    (mode_tile "prev" 0)
    (mode_tile "prev" 1)
  )
  (if (>= n? 32)
    (mode_tile "next" 1)
    (mode_tile "next" 0)
  )
  (if (/= n? 0)
    (setq page$%@# (strcat "第 " (itoa (+ (/ n? 16) 1)) " 頁"))
    (setq page$%@# (strcat "第 1 頁"))
  )
  (set_tile "t1" page$%@#)
)
;;;_______________________________________________________
(defun SHOW (/ n? n?# n??)
  (setq n? 0)
  (while (/= n? 16)
    (setq n?# (nth n? icon_list))
    (setq n? (1+ n?))
    (if        (/= n?# nil)
      (progn
        (setq n?? (itoa n?))
        (start_image n??)
        (FILL_IMAGE 0 0 (DIMX_TILE n??) (DIMY_TILE n??) -2)
        (END_IMAGE)
        (START_IMAGE n??)
        (SLIDE_IMAGE 0 0 (DIMX_TILE n??) (DIMY_TILE n??) n?#)
        (END_IMAGE)
      )
      (progn
        (setq n?? (itoa n?))
        (start_image n??)
        (FILL_IMAGE 0 0 (DIMX_TILE n??) (DIMY_TILE n??) -2)
        (END_IMAGE)
        (START_IMAGE n??)
        (SLIDE_IMAGE 0 0 (DIMX_TILE n??) (DIMY_TILE n??) "")
        (END_IMAGE)
      )
    )
  )
)
;;;_______________________________________________________
(defun SHOW_$# (/ icon_li icon_list@# n?$ icon_n? count)
  (setq icon_list@ (reverse icon_list))
  (setq icon_list@# icon_list)
  (setq icon_list nil)
  (setq n?$ n?)
  (while (< n?$ (+ n? 16))
    (setq icon_n?$ (nth n?$ icon_list@#))
    (setq n?$ (+ n?$ 1))
    (if        (= icon_n?$ nil)
      (progn
        (setq icon_n?$ (strcat "icon" (itoa n?$)))
        (setq icon_list@ (cons icon_n?$ icon_list@))
      )
    )
    (setq icon_list (cons icon_n?$ icon_list))
  )
  (setq icon_list (reverse icon_list))
  (if (/= icon_list@ nil)
    (progn
      (setq fi "cc")
      (if (findfile (strcat fi ".ini"))
        (progn
          (setq fil (findfile (strcat fi ".ini")))
          (setq count 0)
          (setq pe (open fil "W"))
          (while (< count (length icon_list@))
            (setq ddf (nth count (reverse icon_list@)))
            (setq count (1+ count))
            (if        (/= ddf nil)
              (write-line ddf pe)
            )
          )
        )
      )
    )
  )
  (close pe)
)
;;;_______________________________________________________
(defun LS ()
  (start_list "ls" 3)
  (mapcar (quote add_list) lib_list)
  (end_list)
)
;;;_______________________________________________________
(defun ICON_LS (/ fi fil fel pe en1 en2 hcount@# nn$# count$%)
  (setq fi "library")
  (if (findfile (strcat fi ".ini"))
    (progn
      (setq fil (findfile (strcat fi ".ini")))
      (setq fel nil)
      (setq pe (open fil "r"))
      (setq en1 (READ-LINE pe))
      (close pe)
      (setq fil (findfile (strcat en1 ".ini")))
      ;;(setq fil (findfile (strcat (nth (atoi value$) lib_list) ".ini")))
      (setq pe (open fil "r"))
      (setq en2 T)
      (while (/= en2 nil)
        (setq en2 (READ-LINE pe))
        (setq fel (cons en2 fel))
      )
      (close pe)
      (setq icon_list (reverse (cdr fel)))
    )
  )
)
;;;_______________________________________________________
(defun LIB_LS (/ fi fil fel pe en)
  (setq fi "library")
  (if (findfile (strcat fi ".ini"))
    (progn
      (setq fil (findfile (strcat fi ".ini")))
      (setq fel nil)
      (setq pe (open fil "r"))
      (setq en T)
      (while (/= en nil)
        (setq en (read-line pe))
        (setq fel (cons en fel))
      )
      (close pe)
      (setq lib_list (reverse (cdr fel)))
    )
  )
)
;;;_______________________________________________________
(defun LIB_WBLOCK (/              ss         sp?            s?l
                   library_path                 p1            wblockname?#
                   spcircle_dd                 ss1            pt1
                   pt2
                  )
  (setq ss (ssget))
  (if ss
    (progn
      (command "_.UNDO" "Group")
      (command "_.ERASE" "ALL" "R" ss "")
      (command "_.ZOOM" "E")
      (command "_.ZOOM" "0.9X")
      (command "_.REGEN")
      (setq sp? (findfile "library.ini"))
      (setq s?l (strlen sp?))
      (setq library_path (substr sp? 1 (- s?l 11)))
      (setq p1 (getpoint "\nInsert Point"))
      (if (/= n? 0)
        (setq ke$ (itoa (+ (atoi ke$) n?)))
      )
      (setq wblockname?#&$ (strcat (nth 0 lib_list) ke$))
      (setq spcircle_dd (/ (getvar "viewsize") 15))
      (command "_.UNDO" "Group")
      (command "_.CIRCLE" p1 spcircle_dd)
      (setq ss1 (ssget "L"))
      (command "_.CHANGE" ss1 "" "P" "Color" "1" "")
      (setq pt1 (polar p1 pi (+ (/ spcircle_dd 2) (/ spcircle_dd 0.9))))
      (setq pt2 (polar p1 0 (+ (/ spcircle_dd 2) (/ spcircle_dd 0.9))))
      (command "_.LINE" pt1 pt2 "")
      (setq ss1 (ssget "L"))
      (command "_.CHANGE" ss1 "" "P" "Color" "1" "")
      (command "_.ROTATE" ss1 "" p1 "45")
      (command "_.MIRROR" ss1 "" p1 "@0,10" "")
      (command "_.MSLIDE" (strcat library_path wblockname?#&$))
      (command "_.UNDO" "End")
      (command "_.UNDO" "1")
      (command "_.WBLOCK"
               (strcat library_path wblockname?#&$)
               ""
               P1
               ss
               ""
      )
      (WRITE_ICON)
      (command "_.UNDO" "End")
      (command "_.UNDO" "3")
    )
  )
)
;;;_______________________________________________________
(defun LIB_CHS (/           ss              sp?         s?l            library_path
                p1           wblockname?#                 spcircle_dd
                ss1           pt1              pt2
               )
  (setq ss (ssget))
  (if ss
    (progn
      (command "_.UNDO" "Group")
      (command "_.ERASE" "ALL" "R" ss "")
      (command "_.ZOOM" "E")
      (command "_.ZOOM" "0.9X")
      (command "_.REGEN")
      (setq sp? (findfile "library.ini"))
      (setq s?l (strlen sp?))
      (setq library_path (substr sp? 1 (- s?l 11)))
      (setq p1 (getpoint "\nInsert Point"))
      (if (/= n? 0)
        (setq ke$ (itoa (+ (atoi ke$) n?)))
      )
      (setq wblockname?# (strcat (nth 0 lib_list) ke$))
      (setq spcircle_dd (/ (getvar "viewsize") 15))
      (command "_.UNDO" "Group")
      (command "_.CIRCLE" p1 spcircle_dd)
      (setq ss1 (ssget "L"))
      (command "_.CHANGE" ss1 "" "P" "Color" "1" "")
      (setq pt1 (polar p1 pi (+ (/ spcircle_dd 2) (/ spcircle_dd 0.9))))
      (setq pt2 (polar p1 0 (+ (/ spcircle_dd 2) (/ spcircle_dd 0.9))))
      (command "_.LINE" pt1 pt2 "")
      (setq ss1 (ssget "L"))
      (command "_.CHANGE" ss1 "" "P" "Color" "1" "")
      (command "_.ROTATE" ss1 "" p1 "45")
      (command "_.MIRROR" ss1 "" p1 "@0,10" "")
      (command "_.MSLIDE"
               (strcat library_path wblockname?#)
      )
      (command "_.UNDO" "End")
      (command "_.UNDO" "1")
      (command "_.WBLOCK"
               (strcat library_path wblockname?#)
               "Y"
               ""
               P1
               ss
               ""
      )
      (WRITE_ICON)
      (command "_.UNDO" "End")
      (command "_.UNDO" "3")
    )
  )
)
;;;_______________________________________________________
(defun WRITE_ICON (/              fi         icon_number
                   icon_name  new_icon_list            fil
                   pe              count         qwe            ddfr
                  )
  (setq fi "cc")
  (if (findfile (strcat fi ".ini"))
    (progn
      (if (= n? 16)
        (progn
          (setq ke$ (itoa (+ (atoi ke$) n?)))
          (setq icon_number (- (atoi ke$) 17))
        )
        (setq icon_number (- (atoi ke$) 1))
      )
      (if (= n? 32)
        (progn
          (setq ke$ (itoa (+ (atoi ke$) n?)))
          (setq icon_number (- (atoi ke$) 33))
        )
        (setq icon_number (- (atoi ke$) 1))
      )
      (setq icon_name (nth icon_number icon_list))
      (setq new_icon_list (subst wblockname?#&$ icon_name icon_list))
      (setq fil (findfile (strcat fi ".ini")))
      (setq pe (open fil "w"))
      (setq count 0)
      (setq qwe (length new_icon_list))
      (while (< count qwe)
        (setq ddfr (nth count new_icon_list))
        (setq count (1+ count))
        (if (/= ddfr nil)
          (write-line ddfr pe)
        )
      )
    )
  )
  (close pe)
)
;;;_______________________________________________________
(defun WRITE_DEL (/            fi              ic        wblockname?#
                  new_icon_list              fil        pe          count
                  qwe            ddfr
                 )
  (setq fi "cc")
  (if (findfile (strcat fi ".ini"))
    (progn
      (setq ic (strcat "icon" ke$))
      (setq wblockname?# (strcat (nth 0 lib_list) ke$))
      (setq new_icon_list (subst ic wblockname?# icon_list))
      (setq fil (findfile (strcat fi ".ini")))
      (setq pe (open fil "w"))
      (setq count 0)
      (setq qwe (length new_icon_list))
      (while (< count qwe)
        (setq ddfr (nth count new_icon_list))
        (setq count (1+ count))
        (if (/= ddfr nil)
          (write-line ddfr pe)
        )
      )
    )
  )
  (close pe)
)
;;;_______________________________________________________
(defun LIB_INS (/ p1 icon_number icon_name sp? s?l library_path ss)
  (while (setq p1 (getpoint "\nInsert Point"))
    (if        (/= n? 0)
      (setq ke$ (itoa (+ (atoi ke$) n?)))
    )
    (setq icon_number (- (atoi ke$) 1))
    (setq icon_name (nth icon_number icon_list))
    (setq sp? (findfile "library.ini"))
    (setq s?l (strlen sp?))
    (setq library_path (substr sp? 1 (- s?l 11)))
    (command "_.INSERT"
             (strcat library_path icon_name)
             p1
             ""
             ""
             ""
    )
    (setq ss (ssget "L"))
    (if        ss
      (progn
        (command "_.EXPLODE" ss)
        (command "_.PURGE" "Blocks" "" "N")
      )
    )
  )
)
;;;_______________________________________________________
(defun LIB_DEL (/           sp?              s?l         library_path
                icon_number              icon_name         fi            ic
                new_icon_lis              fil         pe            count
                qwe           ddfr
               )
  (setq sp? (findfile "library.ini"))
  (setq s?l (strlen sp?))
  (setq library_path (substr sp? 1 (- s?l 11)))
  (if (/= n? 0)
    (setq ke$ (itoa (+ (atoi ke$) n?)))
  )
  (setq icon_number (- (atoi ke$) 1))
  (setq icon_name (nth icon_number icon_list))
  (setq fi "cc")
  (if (findfile (strcat fi ".ini"))
    (progn
      (setq ic (strcat "icon" ke$))
      (setq new_icon_list (subst ic icon_name icon_list))
      (setq fil (findfile (strcat fi ".ini")))
      (setq pe (open fil "w"))
      (setq count 0)
      (setq qwe (length new_icon_list))
      (while (< count qwe)
        (setq ddfr (nth count new_icon_list))
        (setq count (1+ count))
        (if (/= ddfr nil)
          (write-line ddfr pe)
        )
      )
    )
  )
  (close pe)
  (if (/= ke$ nil)
    (progn
      (vl-file-delete (strcat library_path icon_name ".dwg"))
      (vl-file-delete (strcat library_path icon_name ".sld"))
    )
  )
)
;;;_______________________________________________________
(defun LIB_ZOOM        (/ icon_number icon_name dli)
  (if (/= icon_list nil)
    (progn
      (if (/= n? 0)
        (setq ke$ (itoa (+ (atoi ke$) n?)))
      )
      (setq icon_number (- (atoi ke$) 1))
      (setq icon_name (nth icon_number icon_list))
    )
  )
  (setq dli (load_dialog "library.dcl"))
  (if (null (new_dialog "zoom" dli))
    (exit)
  )
  (start_image "lib_zoom")
  (fill_image
    0
    0
    (dimx_tile "lib_zoom")
    (dimy_tile "lib_zoom")
    -2
  )
  (end_image)
  (start_image "lib_zoom")
  (slide_image
    0
    0
    (dimx_tile "lib_zoom")
    (dimy_tile "lib_zoom")
    icon_name
  )
  (end_image)
  (start_dialog)
  (unload_dialog dli)
)
;;;_______________________________________________________
(defun LIB_TYPE        (/ ke icon_number icon_name)
  (setq key ke$)
  (if (/= n? 0)
    (setq key (itoa (+ (atoi key) n?)))
  )
  (setq icon_number? (- (atoi key) 1))
  (setq icon_name? (nth icon_number? icon_list))
  (if (= n? 0)
    (setq ic (strcat "icon" key))
  )
  (if (= n? 16)
    (progn
      (setq key (itoa (- (atoi key) 16)))
      (setq ic (strcat "icon" (itoa (+ (atoi key) 16))))
    )
  )
  (if (= n? 32)
    (progn
      (setq key (itoa (- (atoi key) 32)))
      (setq ic (strcat "icon" (itoa (+ (atoi key) 32))))
    )
  )
  ;;(if (= n? 32)
  ;;(setq ke$ (itoa (- (atoi ke$) 32)))
  ;;)
  ;;(if (= n? 48)
  ;;(setq ke$ (itoa (- (atoi ke$) 48)))
  ;;)
  ;;(if (= n? 64)
  ;;(setq ke$ (itoa (- (atoi ke$) 64)))
  ;; )
  ;;(if (= n? 80)
  ;;(setq ke$ (itoa (- (atoi ke$) 80)))
  ;;)
  ;;(if (= n? 96)
  ;;(setq ke$ (itoa (- (atoi ke$) 96)))
  ;;)
  ;;(if (= n? 112)
  ;;(setq ke$ (itoa (- (atoi ke$) 112)))
  ;;)
  ;;(if (= n? 128)
  ;;(setq ke$ (itoa (- (atoi ke$) 128)))
  ;;)
  ;;(if (= n? 144)
  ;;(setq ke$ (itoa (- (atoi ke$) 144)))
  ;;)
  (if (= icon_name? ic)
    (action_tile key "(done_dialog 4)")
  )
)
;;;_______________________________________________________
(defun NUBMER%%@ ()
  (setq n? 0)
)
;;;_______________________________________________________
(defun c:library (/ dcl_id what_next)
  (setvar "MODEMACRO" "***SPRING***")
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.UNDO" "Group")
  (setq dcl_id (load_dialog "library.dcl"))
  (setq what_next 7)
  (while (> what_next 2)
    (if        (null (new_dialog "library" dcl_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
    (if        (= value$ nil)
      (setq value$ "0")
    )
    (NUBMER%%@)
    (LIB_LS)
    (ICON_LS)
    (LS)
    (SHOW)
    (PREV_LOUN)
    (set_tile "t2" "Email: hch-1983@163.com")
    (action_tile "ls" "(setq value$ $value)")
    (action_tile "1" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "2" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "3" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "4" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "5" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "6" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "7" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "8" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "9" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "10" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "11" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "12" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "13" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "14" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "15" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "16" "(setq ke$ $key)(LIB_TYPE)")
    (action_tile "zom" "(done_dialog 3)")
    (action_tile "ins" "(done_dialog 5)")
    (action_tile "ch" "(done_dialog 6)")
    (action_tile "del" "(done_dialog 7)")
    (action_tile
      "next"
      "(setq n? (+ n? 16))(SHOW_$#)(SHOW)(ICON_LS)(PREV_LOUN)"
    )
    (action_tile
      "prev"
      "(setq n? (- n? 16))(SHOW_$#)(SHOW)(ICON_LS)(PREV_LOUN)"
    )
    (NUBMER%%@)
    (setq what_next (start_dialog))
    (cond
      ((= what_next 4)
       (LIB_WBLOCK)
      )
      ((= what_next 3)
       (LIB_ZOOM)
      )
      ((= what_next 5)
       (LIB_INS)
      )
      ((= what_next 6)
       (LIB_CHS)
      )
      ((= what_next 7)
       (LIB_DEL)
      )
      ((= what_next 0)
       (prompt "\n***EXIT***")
      )
    )
  )
  (unload_dialog dcl_id)
  (command "_.UNDO" "End")
  (setvar "cmdecho" cm)
  (princ)
)
;;;_______________________________________________________
(princ "\n     Type: library to run Program")


;;;上面的程序還存在很多問題,最近比較忙,等有空在把後面的.......

aeo

可以用一下xd-api,或doslib把幻灯合成库.晓东api对幻灯处理很方便的.

hqd9639

用LISP写的功能都差不多，还是习惯于自已写的：

spring1983

看來你的功能比我的要強大.呵呵!

zxb888

欢迎试试太阳图库啊！
----------------------
重复回帖－－－netbee