求修改这个程序，新建一个文件夹
如下程序，求修改一下，在目录下新建一个分图的文件夹，吧分图保存到分图文件夹下(defun C:KMFT (/ ANSWER EN FLAG FLAG1 INITDIR NEWDNAME NEWDNAME1 SS)
(command "undo" "be")
(if (setq Initdir (getvar "dwgprefix"))
nil
(progn (princ "\n 文件未保存,不能分图") (exit))
)
(setq flag1 T)
(while (and flag1
(setq en0 (entsel "\n >拾取文件名 "))
(setq en (nentselp (cadr en0)))
(setq NewDName (cdr (assoc 1 (entget (car en)))))
(equal (type NewDName) 'STR)
)
(if(findfile (strcat Initdir NewDName ".DWG"))
(progn(setq flag T)(setq i 1))
)
(while flag
(setq ii (rtos i 2 0))
(setq NewDName1 (strcat NewDName "_" ii ))
(if (findfile (strcat Initdir NewDName1 ".DWG"))
nil
(progn (setq flag nil)(setq NewDName NewDName1))
)
(setq i (+ i 1 ))
)
(setq q (entsel"\n对象图框:"))
(setq sel (car q))
(command "zoom" "o" sel "")
(vl-load-com)
(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
(setq obj (vlax-ename->vla-object sel))
(vla-GetBoundingBox obj 'minpt 'maxpt)
(setq minPt1 (vlax-safearray->list minPt))
(setq maxPt1 (vlax-safearray->list maxPt))
(Setq SS (ssget "_C"maxPt1 minPt1 ))
(command "_.WBLOCK" (strcat Initdir NewDName) """0,0" ss "" )
)
(command "undo" "e")
(princ)
)
页:
[1]