关于图库系统的后续改写

尘缘一生

请移步帖子：

http://bbs.mjtd.com/thread-186146-1-1.html

• ;新建图块--------
•   (defun c:sl-lib-blockadd (/ dcl_id dlg ss pt sl-blkpath ps p1 p2 ss1 ss2 ss3)
•     (setq dcl_id (load_dialog (sl_lib_tkmm)))
•     (new_dialog "tukuairen" dcl_id)
•     (action_tile "edt_name" "(setq $sl_newname $value)")
•     (set_tile "txt_name" (slmsg "新建图块" "新建圖塊" "New Block"))
•     (set_tile "edt_name" (slmsg "新块名" "新塊名" "New Block Name"))
•     (action_tile "accept" "(done_dialog 1)")
•     (setq dlg (start_dialog))
•     (if (= dlg 1)
•       (progn
•         (setq $sl_newname (vl-string-translate "|\\/?*:\"<>" "_________" $sl_newname))
•         (setq sl-blkpath (strcat $sl_libpath (cdr $sl_libcurrent) "\\" $sl_newname))
•         (prompt (slmsg "\n 选择图形:" "\n  選擇圖形:" "\n Select Graph:"))
•         (setq ps (sl_pm2pt) p1 (car ps)  p2 (cadr ps))
•         (setq ss1 (ssget "x"))
•         (setq ss2 (ssget))
•         (command "._Select" ss1 "_Remove" ss2 "")
•         (setq ss3 (ssget "_p"))
•         (sl:ycwt ss3) ;;隐藏其余部分
•         (command "ZOOM" "E")
•         (setq pt (caddr (sl_pm2pt)))
•         (command "COPY" ss2 "" pt pt)
•         (command "-wblock" (strcat sl-blkpath ".dwg") "" pt ss2 "")
•         (command "._mslide" (strcat sl-blkpath ".sld"))
•         (sl:xswt) ;;恢复隐藏
•         (command "ZOOM" "W" p1 p2)
•         (sl-lib-main1)
•       )
•     )
•   )
  

• ;;替换当前，刷新幻灯---------------
•   (defun sl-lib-slidereplace (/ ss pt)  
•     (slexit
•       (slmsg
•         "当前图，作其整图同名幻灯，存与其目录下！"
•         "當前圖，作其整圖同名幻燈，存與其目錄下！"
•         "The current image is a slide with the same name as the whole image and stored in its directory！"
•       )
•       (slmsg
•         "是否继续？请选择是否继续!"
•         "是否繼續？請選擇是否繼續!"
•         "Do you want to continue? Please select whether to continue!"
•       )
•     )
•     (setq $sl_newname (cadr (assoc $sl_libindex $sl_blocklist)))
•     (setq $sl_newname (strcat $sl_libpath (cdr $sl_libcurrent) "\\" $sl_newname))
•     (vl-file-delete (strcat $sl_newname ".dwg"))  ;删除原有dwg文件
•     (vl-file-delete (strcat $sl_newname ".sld"))  ;删除原有dwg文件
•     (command "ZOOM" "E")
•     (setq ss (ssget "x"))
•     (setq pt (caddr (sl_pm2pt)))
•     (command "COPY" ss "" pt pt)
•     (command "-wblock" (strcat $sl_newname ".dwg") "" pt ss "")
•     (command "._mslide" (strcat $sl_newname ".sld"))
•     (command "ZOOM" "E")
•     (sl-lib-main1)
•   )
•   ;;选择替换----------------------
•   (defun sl-lib-blockreplace (/ ss1 ss2 ss3 pt ps p1 p2)
•     (setq $sl_newname (cadr (assoc $sl_libindex $sl_blocklist)))
•     (setq $sl_newname (strcat $sl_libpath (cdr $sl_libcurrent) "\\" $sl_newname))
•     (vl-file-delete (strcat $sl_newname ".dwg"))  
•     (vl-file-delete (strcat $sl_newname ".sld"))
•     (prompt (slmsg "\n 选择图形:" "\n  選擇圖形:" "\n Select Graph:"))
•     (setq ps (sl_pm2pt) p1 (car ps) p2 (cadr ps))
•     (setq ss1 (ssget "x"))
•     (setq ss2 (ssget))
•     (command "._Select" ss1 "_Remove" ss2 "")
•     (setq ss3 (ssget "_p"))
•     (sl:ycwt ss3) ;;隐藏其余部分
•     (command "ZOOM" "E")
•     (setq pt (caddr (sl_pm2pt)))
•     (command "COPY" ss2 "" pt pt)
•     (command "-wblock" (strcat $sl_newname ".dwg") "" pt ss2 "")
•     (command "._mslide" (strcat $sl_newname ".sld"))
•     (sl:xswt) ;;恢复隐藏
•     (command "ZOOM" "W" p1 p2)
•     (sl-lib-main1)
•   )
  

链接：https://pan.baidu.com/s/1UCJtFdLy2DlFcLesMeYyqg
提取码：gy87

lxl217114

建议大佬整个独立运行的

GNJLISP

建议大佬整个独立运行的

paulpipi

你能帮忙出一个单独图库完整的程序吗？你这个看起来非常好用

tomonkey239

这个要钱的，是在推销啊。