如何转化低版本的建新文档LISP程序到高版本去

lizhoufi

(vl-load-com)
(defun c:test( / doc)
  (setq doc (vla-get-documents (vlax-get-acad-object)))
  (setq doc (vla-add doc "c:/ht/bzt/v111"))
  (vla-saveas doc "e:\\wjh\\study\\autolisp\\1.dwg"  acR15_DWG)
  (vla-activate doc)
)
这个程序可以在2000和2004中打开，问题是打开预定的模板后，又重新开启一个新文件，模板上的内容必须要关掉最后出现的新图才能出现。请教的问题是：新建一个图形，要求打开模板后，在同一图形上，将模板图形更名，保存文件。

meflying

不明白你的意思，这个程序的过程是这样的，不管你现在处在什么位置，执行程序后，程序会打开一个你指定的摸板文件，并将这个摸板另存为你指定的文件名。最后将这个文档切换到当前文档。

”新建一个图形，要求打开模板后，在同一图形上“，不知道你的这个”图形“和”文档“的关系是什么？
其实如果你会写程序，根据以上的函数，你完全可以写出满足你自己意思的程序。

lizhoufi

程序可以运行，但是打开模板后，重新生成的是另一张图，原来模板上的图形，必须等到取消这一新图形后才出现。我的问题是：在命令行输入一个文件名，这个文件名将原先模块改名，并保存。在r12中可以用我上次提供的程序可以解决，但2000以上不可以。

meflying

我还是不明白你的意思，看看动画，这就是我的意思，
打开这个模版就代表你的那个c:/ht/bzt...看看上面最后的文件名，就是你要保存的文件。

再重申一次，因为你是开发者，而不是最终用户，你可以根据以上代码写出满足你自己要求的程序，不需要我把程序写到完全符合你的意思的

picachoboy

用LISP生成一个SCR文件,然后在程序里调用这个文件试试哦哦,新老版本都有效的

lizhoufi

vl-load-com)
(defun c:test( / doc)
  (setq doc (vla-get-documents (vlax-get-acad-object)))
  (setq doc (vla-add doc "c:/ht/bzt/v111"))
  (vla-saveas doc "e:\\wjh\\study\\autolisp\\1.dwg"  acr15_dwg)
  (vla-activate doc)
)
情况是这样的：在CAD2000中加载上述程序后，v111图形文件打开了，然后又出现1.dwg,是两个图形文件，关闭或最小化1文件后，v111图形文件出现。而我的意思是加载上述文件后只出现v111图形文件，并且将v111改名为1.dwg.

meflying

可我这那个1.dwg就是v111另存而来的，
那你说那个1.dwg不是v111,那他是什么图形的到的？

lizhoufi

具体情况是这样的：
就是我要打开v111.dwg,打开后将v111.dwg改名为1.dwg,图形仍然是原来的图形，仅仅是改了名称而已，但按提供的程序，不能提供这样的要求。

meflying

你看我的动画了吗？
你那中可能是无法实现的，你想想哪种软件能在打开的情况下改文件名，要想改，只能另存为。

还有我的后一半话你怎么就看不进去呢？你既然是编程，实现代码都给出来了，只是一种你自己的效果，应该不难办到。。。。。。。。。。。。。。

前生

BDYCAD发表于2003-9-13 11:43:00樓上, 有些LISP文件以是一堆亂碼.不知能不能轉成可以志看得明白的源代碼. 如這個文件.大家
參考參考.



1004

--------------------------------------------------------------...

上面的程序如下/
;;;Fast 版权所有(c)刘运华1996
;;;未经书面授权，不得使用、复制、销售、修改本程序
;;;txt,sd dt
;;;
(defun C:TXT ()
;;;sun function
(defun do_dia ( / pt1 cau ac flap hei heig dcl_id index MyKey MyNum CmName)

(defun Get_My (value key)
    (setq MyNum (atoi value)
          MyKey key
    )
    (if (= "custom" MyKey)
        (set_tile "input" (nth MyNum data))
        (set_tile "input" (nth MyNum data1))
    )
)

(defun Add_My (Name / filename n nn ndata nndata bb)
  (if (null MyKey)
   (set_tile "caution" "错误：先选片名，再于此位置增加或移去")
   (progn
    (set_tile "caution" "")
   
   (if (= "custom" MyKey)
      (progn
         (setq filename (findfile "shoe.dat")
               nn (length data)
               ndata data
         )
      )
      (progn
         (setq filename (findfile "shoe1.dat")
               nn (length data1)
               ndata data1
         )
      )
   )

   (setq fp (open filename "w")
         n 0
         nndata '()
   )

    (start_list MyKey)
   (while (< n nn)
     (setq bb (nth n ndata))
     (write-line bb fp)
     (add_list bb)
     (setq nndata (append nndata (list bb)))
     (if (= MyNum n)
        (progn
           (write-line Name fp)
           (add_list Name)
           (setq nndata (append nndata (list Name)))
        ))
     (setq n (1+ n))
  )
  (close fp)
  (end_list)
  (if (= "custom" MyKey) (setq data nndata) (setq data1 nndata))
  (setq ndata nil nndata nil)
  
  ));;progn
  
)

(defun Rem_My (Name / filename n nn ndata nndata bb)
   (if (null MyKey)
   (set_tile "caution" "错误：先选片名，再于此位置增加或移去")
   (progn
    (set_tile "caution" "")

   (if (= "custom" MyKey)
      (progn
         (setq filename (findfile "shoe.dat")
               nn (length data)
               ndata data
         )
      )
      (progn
         (setq filename (findfile "shoe1.dat")
               nn (length data1)
               ndata data1
         )
      )
   )

   (setq fp (open filename "w")
         n 0
         nndata '()
   )

   (start_list MyKey)
   (while (< n nn)
     (if (/= MyNum n)
        (progn
           (setq bb (nth n ndata))
           (write-line bb fp)
           (add_list bb)
           (setq nndata (append nndata (list bb)))
        ))
     (setq n (1+ n))
  )
  (close fp)
  (end_list)
  (if (= "custom" MyKey) (setq data nndata) (setq data1 nndata))
  (setq ndata nil nndata nil)

  ));;progn
)

;;;写厂名
(defun Write_Cm ( / ss sslen n ent dd pt ang hei)
   (setq hei (getvar "textsize"))
   (setq ss (ssget "X" '((62 . 73))))
   (if ss
     (progn //有片名
       (princ "\n正在处理...")
       (setq sslen (sslength ss))
       (setq n 0)
       (while (< n sslen)
         (setq dd (entget (ssname ss n)))
         (setq pt (cdr (assoc 10 dd))
               ang (cdr (assoc 50 dd)))
         (setq pt (polar pt (+ (* pi 0.5) ang) (+ 1.0 hei) ))
         (setq ang (/ (* ang 180.0) pi))
         (command "text" "s" "chinese" pt hei ang CmName)
         (setq ent (entlast))
         (command "change" ent "" "p" "la" "1" "")
         (setq n (1+ n))
       )
       (princ "  共计 ")(princ sslen)(princ " 个厂名.")
     )
   )
)

;;;main dcl
(if (< (setq dcl_id  (load_dialog "text.dcl")) 0)  (exit))
(new_dialog "bbtext" dcl_id)
(setq data '())
(setq fp (open (findfile "shoe.dat") "r"))                                   
(start_list "custom")
(while (setq aa (read-line fp))
    (setq data (append data (list aa)))
    (add_list aa)
)
(end_list)
(close fp)
(setq data1 '())
(setq fp (open (findfile "shoe1.dat") "r"))           
(start_list "present")
(while (setq aa (read-line fp))
    (setq data1 (append data1 (list aa)))
    (add_list aa)
)
(end_list)
(close fp)
(setq MyKey nil MyNum nil MyName nil)
(action_tile "custom" "(Get_My $value $key)")
(action_tile "present" "(Get_My $value $key)")
(action_tile "add"  "(Add_My (get_tile \"input\") )")
(action_tile "remove" "(Rem_My (get_tile \"input\"))")
(action_tile "accept" "(setq MyName (get_tile \"input\"))(done_dialog 1)")
(action_tile "cm" "(if (/= 0 (strlen (setq CmName (get_tile \"input\")))) (done_dialog 2)
   (set_tile \"caution\" \"错误：应先选厂名，再按[厂名]键\") )")
(setq index (start_dialog))
(if (= index 1) (txtdo))
(if (= index 2) (Write_Cm))
(unload_dialog dcl_id)
(setq data '() data1 '())                                                      
)

   (seterr)
   (command "chkval")
   (if (not (= 1 #chkval)) (exit))
   (do_dia)
   (geterr)
   (princ)
)
;;;
;;;代替字母
(defun C:DT ( / objs chm ent o_str o_slen n_str n_slen last_o tot_o class
                chf si s_temp st cont ans)
   ;; Select objects if running standalone
  (seterr)
  (command "chkval")
  (if (not (= 1 #chkval)) (exit))
  (princ "\n作用范围(选取或按[完]).")
  (setq objs (ssget))
  (setq chm 0)
  (if objs
    (progn                   ;; If any objects selected
      (if (= (sslength objs) 1)
          (progn
            (setq ent (entget (ssname objs 0)))
            (princ (strcat "\n所选: " (cdr (assoc 1 ent))))
          )
      )
      (setq o_str (getstring "\n旧字符: " t))
      (setq o_slen (strlen o_str))
      (if (/= o_slen 0)
        (progn
          (setq n_str (getstring "\n新字符: " t))
          (setq n_slen (strlen n_str))
          (setq last_o 0
                tot_o  (sslength objs)
          )
          ;; For each selected object...
          (while (< last_o tot_o)
            (setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
            (if (or (= "TEXT" class)
                    (= "MTEXT" class) )
              (progn
                (setq chf nil si 1)
                (setq s_temp (cdr (assoc 1 ent)))
                (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                  (if (= st o_str)
                    (progn
                      (setq s_temp (strcat
                                     (if (> si 1)
                                       (substr s_temp 1 (1- si))
                                       ""
                                     )
                                     n_str
                                     (substr s_temp (+ si o_slen))
                                   )
                      )
                      (setq chf t)    ;; Found old string
                      (setq si (+ si n_slen))
                    )
                    (setq si (1+ si))
                  )
                )
                (if chf
                  (progn              ;; Substitute new string for old
                    ;; Modify the TEXT entity
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                    (setq chm (1+ chm))
                  )
                )
              )
            )
            (setq last_o (1+ last_o))
          )
        )
        ;; else go on to the next line...
      )
    )
  )
  ;; Print total lines changed
  (if (/= (sslength objs) 1)
      (princ (strcat (rtos chm 2 0) " 处文字改变."))
  )
  (geterr)
  (princ)
)
;;;replace text
(defun C:DW( / ent o_str n_str ss iii len)
  (seterr)
  (command "chkval")
  (if (not (= 1 #chkval)) (exit))
  (if (setq ent (entsel "\n选取要替代的文字:"))
    (progn
       (princ (setq o_str (cdr (assoc 1 (entget (car ent))))))
       (setq n_str (getstring T "\n新的文字:"))
       (setq ss (ssget "x" (list (cons 0 "text") (cons 1 o_str)))
             iii 0
             len (sslength ss))
       (while (setq ent (ssname ss iii))
          (setq ent (entget ent))
          (entmod (subst (cons 1 n_str) (assoc 1 ent) ent))
          (setq iii (1+ iii))
       )
       (princ (strcat (rtos len 2 0) " 处文字改变."))
  ))
  (geterr)
  (princ)
)
;;;ddedit text
(defun C:DD( / ent)
  (seterr)
  (command "chkval")
  (if (not (= 1 #chkval)) (exit))
  (while (setq ent (entsel "\n选取要修改的文字:"))
     (command "ddedit" ent "")
  )
  (geterr)
  (princ)
)
;;;
(princ)