分图

newbuser

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

liu22737

kwok 发表于 2013-10-29 14:53
文件名也能直接输入更好些吧

用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

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

ckss

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

totoro

看实现到什么地步

szx025

kkkkkkkkkkkkk

xujinhua

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

ynhh

看看黄工是如何分的哈

86023383

好东西~~好东西~~

edsion24

打开看看