求改一代码,不清楚规则很抱歉

wgij007

• 求改一代码，分图后不删原图,感激。
• 原贴
• http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108136&highlight=%B7%D6%CD%BC
  

• ;;分图
• ;;假如一个文件内画许多图，用电脑的搜索功能可能找不到，需拆分，以文件名保存，但于后来找查
• (defun C:ft (/ ANSWER EN FLAG FLAG1 INITDIR NEWDNAME SS)
•   (if (setq Initdir (getvar "dwgprefix"))
•     nil
•     (progn (princ "\n 文件未保存,不能分图") (exit))
•   )
•   (setq flag1 T)
•   (while (and flag1
•         (setq en (entsel "\n >拾取文件名 "))
•         (setq en (nentselp (cadr en)))
•         (setq NewDName (cdr (assoc 1 (entget (car en)))))
•         (equal (type NewDName) 'STR)
•    )
•     (if  (findfile (strcat Initdir NewDName ".DWG"))
•       (setq flag T)
•     )
•     (while flag
•       (princ
•   (strcat "\n 文件名" NewDName "已经存在，请重输入文件名")
•       )
•       (setq NewDName (getstring "\n???输入文件名: "))
•       (if (findfile (strcat Initdir NewDName ".DWG"))
•   nil
•   (setq flag nil)
•       )
•     )
•     (princ "\n >>此图范围")
•     (setvar "NOMUTT" 1)
•     (setq ss (ssget))
•     (setvar "NOMUTT" 0)
• 
•     (command "_.WBLOCK"
•        (strcat Initdir NewDName)
•        ""
•        "0,0"
•        ss
•        ""
•     )
•     (princ (strcat "\n >>>文件" NewDName "成功保存!!!\n"))
•     (if  (ssget "X")
•       (progn
•   (initget "Yes No")
•   (setq answer (GETKWORD "[停止(N)/断续(Y)]<断续Y>"))
•   (if (equal answer "No")
•     (setq flag1 nil)
•   )
•       )
•       (setq flag1 nil)
•     )
•   )
•   (princ)
• )
  

bssurvey

       (command "undo" "be") ;可以在此加入這一行
       (command "_.WBLOCK"
       (strcat Initdir NewDName)
       ""
       "0,0"
       ss
       ""
    )        (princ (strcat "\n >>>文件" NewDName "成功保存!!!\n"))
    (command "undo" "b") ;在此加入這一行

wgij007

bssurvey 发表于 2021-1-20 09:00
(command "undo" "be") ;可以在此加入這一行
       (command "_.WBLOCK"
       (strcat Initdi ...

很感谢，