newbuser 发表于 2014-1-11 14:28:12

分图的程序一直没人分享，今日有幸得见，真乃三生有幸啊。

liu22737 发表于 2014-1-12 16:58:14

本帖最后由 liu22737 于 2014-1-12 17:12 编辑

kwok 发表于 2013-10-29 14:53 static/image/common/back.gif
文件名也能直接输入更好些吧
用GRREAD凑合下试试
替换掉此段
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(while (and flag1
      (setq en (entsel "\n >拾取文件名 "))
      (setq en (nentselp (cadr en)))
      (setq NewDName (cdr (assoc 1 (entget (car en)))))
      (equal (type NewDName) 'STR)
   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun C:ft(/ ANSWER EN FLAG FLAG1 INITDIR NEWDNAME SS)
(if (setq Initdir (getvar "dwgprefix")) nil
    (progn (princ "\n 文件未保存,不能分图") (exit))
)
(setq flag1 T flag2 T)
(while flag1
   (while flag2(prompt "\n >拾取文件名 ")
      (setq gr(grread nil 4 2))
      (cond((=(car gr)3)
                (if(setq en (nentselp (cadr gr)))
                        (progn
                              (setq NewDName (cdr (assoc 1 (entget (car en)))))
                              (if(equal (type NewDName) 'STR)(setq flag2 nil))
                        )
                )
             )
         ((=(car gr)2)(setq str(cadr gr))
                (if(> str 32)(setq flag2 nil NewDName(strcat(chr str)(getstring(chr str)))))
                )
         ((=(car gr)5)(setq flag2 T))
         (t(exit))
         );cond
    );while flag2
(setq NewDName(vl-list->string(vl-remove 47
                              (vl-remove 92
                              (vl-remove 34
                              (vl-remove 39
                              (vl-remove 60
                              (vl-remove 62
                              (vl-remove 63
                              (vl-remove 42
                              (vl-remove 58
                              (vl-remove 124
                              (vl-remove 32
      (vl-string->list NewDName)))))))))))));setq
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (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)
)

dkfylxs 发表于 2014-1-12 17:57:26

学习学习............

ckss 发表于 2014-3-2 00:36:39

學習.................................

totoro 发表于 2014-3-2 01:35:21

看实现到什么地步

szx025 发表于 2014-3-2 09:55:37

kkkkkkkkkkkkk

xujinhua 发表于 2014-3-2 10:47:15

强人又出好东西...必顶

ynhh 发表于 2014-3-2 21:31:29

看看黄工是如何分的哈

86023383 发表于 2014-4-23 00:43:12

好东西~~好东西~~

edsion24 发表于 2014-4-23 09:20:45

打开看看         
页: 1 2 3 [4] 5 6 7 8 9 10 11 12 13
查看完整版本: 分图