[LISP程序]：我一同事编的，字符串编辑，dd命令的加强版

青马

命令文件在第二贴

青马

ddt

lhg

好程序！提高效率！！！！

它山之石

程序有点创意。但放在这个版块似乎不妥。
这是放源码的。

青马

源码没问题，不知贴dcl行不行，这人可真怪啊，不收钱的时候没人下，收钱下载就有好几个在下载，怪啊，呵呵
(defun ddt1 (key$ zhi$)
  (mode_tile key$ 0)
  (set_tile key$ zhi$)
)
;;=====================================================
(defun ddt1a (key$)
  (setq tp (strcat  tp (get_tile key$)))
)
;;================================================================
(defun ddt2 (a$)
    (if (<= n3 9)
   (progn
    (setq tt1 (get_tile "text1") j 1 tp nil)
    (setq tp tt1)
    (repeat (- n3 1)
       (setq j (+ 1 j))
       (setq key (strcat "text" (itoa j)))
       (ddt1a key)
    )
    (set_tile "zf" tp)
   ))
)
;================================================================
(defun ddt4(a1$ jia$ J$)
  (setq key (strcat "text" (itoa j$)))
  (setq shu (get_tile key))
  (if (= jia$ 1) (set_tile key (itoa (+ (atoi shu) 1)))
                 (set_tile key (itoa (- (atoi shu) 1)))
  )
  (ddt2 1)
)
;============================================================
(defun ddt5(a1$)  
  (setq txt (get_tile "zf"))

  (ddt3 txt)
(if (<= n3 9)(progn
  (ddt7 1)
  (ddt6 1)
  (ddt2 1)
  )
  (progn (setq tp (get_tile "zf")) (ddt6 1))
)
)
;=================================================================
(defun ddt7 (a$)
  (setq i 0)
  (repeat 9
    (setq i (+ 1 i))
    (setq key (strcat "text" (itoa i)))
    (set_tile key "")
)
)
;=================================================================
(defun ddt6 (a$)
  (setq i 0)
  (repeat 9
    (setq i (+ 1 i))
    (setq key (strcat "text" (itoa i)))
    (setq key1 (strcat "j" (itoa i)))
    (mode_tile key 1)
    (mode_tile key1 1)
)

(if (<= n3 9)
  (progn
  (if (= zf 0) (setq i1 1 i11 -1 i2 2 i22 -1)
               (setq i1 2 i11 -1 i2 1 i22 -1)
  )
  (repeat n1
    (setq i11 (+ 1 i11))
    (setq key (strcat "text" (itoa  i1)))
    (setq zhi (nth i11 txt1$))
    (setq key2 (strcat "j" (itoa i1)))
    (mode_tile key2 0)
    (ddt1 key zhi)
    (setq i1 (+ 2 i1))
  )
  (mode_tile key 2)
  (repeat n2
    (setq  i22 (+ 1 i22))
    (setq key (strcat "text" (itoa i2)))
    (setq key2 (strcat "j" (itoa i2)))
    (setq zhi (nth  i22  txt2$))
   
    (ddt1 key zhi)
    (setq i2 (+ 2 i2))
  )
)
(progn (set_tile "text1" "(-8*****")
        (set_tile "text2" "位数太多")
        (set_tile "text3" "*****8-)")
)
)
)
;;===============================================================
(defun ddt8 (a$ b$)
  (setq comm b$)
   

)
;================================================================
(defun c:ddt ()
  (setq n1 0 n2 0 n3 0)
  (setq i 0  txt2$ () st () txt1$ () txt3$ () js 0 aa 1)
  (setq e (entsel "\n请点选字符:"))
   
  (if (= e nil)  (progn (princ "\n         首先感谢您使用本套软件!")
                 (princ "\n遗憾的是您没有选中字符!是字不够大吗?还是框不够大?")
                )
  (progn
  (setq na (nth 0 e))
  (setq e1 (entget na))
  
  (setq txt (cdr (assoc '1 e1)) txt11 txt tp txt)
  (if (= nil txt) (princ "\n您没有选中字符!是字不够大吗?还是框不够大?")
     (progn

  (setq zx (cdr (assoc '7 e1)) zg (cdr (assoc '40 e1))
        zj (angtos (cdr (assoc '50 e1)) 0 5))
  
  (ddt3 txt)
  (setq        filename "ddt")
  (setq index_value (load_dialog filename))
  (new_dialog "ddt" index_value)

  (ddt6 1)
  (if (= comm nil)(progn (setq comm 1)(set_tile "ch" "1"))
                  (cond ((= comm 1) (set_tile "ch" "1"))
                        ((= comm 2) (set_tile "mo" "1"))
                        ((= comm 3) (set_tile "cp" "1"))
                  )
  )
  (set_tile "zf" txt)
  (action_tile "text1" "(ddt2  $value)")
  (action_tile "text2" "(ddt2  $value)")
  (action_tile "text3" "(ddt2  $value)")
  (action_tile "text4" "(ddt2  $value)")
  (action_tile "text5" "(ddt2  $value)")
  (action_tile "text6" "(ddt2  $value)")
  (action_tile "text7" "(ddt2  $value)")
  (action_tile "text8" "(ddt2  $value)")
  (action_tile "text9" "(ddt2  $value)")
  (action_tile "jia1" "(ddt4  $value 1 1)")
  (action_tile "jian1" "(ddt4  $value 0 1)")
  (action_tile "jia2" "(ddt4  $value 1 2)")
  (action_tile "jian2" "(ddt4  $value 0 2)")
  (action_tile "jia3" "(ddt4  $value 1 3)")
  (action_tile "jian3" "(ddt4  $value 0 3)")
  (action_tile "jia4" "(ddt4  $value 1 4)")
  (action_tile "jian4" "(ddt4  $value 0 4)")
  (action_tile "jia5" "(ddt4  $value 1 5)")
  (action_tile "jian5" "(ddt4  $value 0 5)")
  (action_tile "jia6" "(ddt4  $value 1 6)")
  (action_tile "jian6" "(ddt4  $value 0 6)")
  (action_tile "jia7" "(ddt4  $value 1 7)")
  (action_tile "jian7" "(ddt4  $value 0 7)")
  (action_tile "jia8" "(ddt4  $value 1 8)")
  (action_tile "jian8" "(ddt4  $value 0 8)")
  (action_tile "jia9" "(ddt4  $value 1 9)")
  (action_tile "jian9" "(ddt4  $value 0 9)")
  
  (action_tile "zf" "(ddt5  $value)")
  (action_tile "ch" "(ddt8  $value 1)")
  (action_tile "mo" "(ddt8  $value 2)")
  (action_tile "cp" "(ddt8  $value 3)")

   (setq okno (start_dialog))
  (unload_dialog index_value)

(if (= okno 1)
(progn
(if (= comm 1)
     (progn
          (setq e1 (subst (cons 1 tp) (cons 1 txt11) e1))
           (entmod e1)
           (entupd na)
      )
)
(if (= comm 2) (progn (setq q1 (getpoint "\n点选基准点:"))
                 (setq e1 (subst (cons 1 tp) (cons 1 txt11) e1))
                  (entmod e1)
                  (entupd na)
                 (command "move" na "" q1 pause ))
)
(if (= comm 3)  (progn (setq q1 (getpoint "\n点选新位置:"))
                        (command "text" "s" zx q1 zg zj tp )
                  )
)
)
)

))
))
(princ)
)
(princ "\n 本软件是有想法多多的gaoxin提出的，有yjh制作完成的。程序已经加载,启动命令 ddt。")
(princ "\n              上网就上 go5.163.com")
(princ "／yangjh123 ")
;===============================================================
(defun ddt3(txt$)
  (setq i 0  txt2$ () st () txt1$ () txt3$ () js 0 aa 1)
  (setq t1 (ascii (substr txt$ 1 1)))
;; (princ txt$)
  (if (and (>= t1 48) (<= t1 57))(setq zf 0)(setq zf 1))
  (setq n (strlen txt$))
   (repeat n
     (setq i (+ i 1))
     (setq a1 (substr txt$ i 1) a1$ (ascii a1))
     (if (and (>= a1$ 48) (<= a1$ 57)) (setq ttt 1) (setq ttt 0))
     (if (/= i n)
      (setq a2 (substr txt$ (+ i 1) 1) a2$ (ascii a2))
     )
    ; (princ "a2$=")(princ a2$)
     (if (and (>= a2$ 48) (<= a2$ 57) (/= i n)) (setq ttt1 1)(setq ttt1 0))
     (if (= i n) (cond ((= ttt 1) (setq ttt1 0))
                       ((= ttt 0) (setq ttt1 1))
                 )
     )
   
   (if  (= ttt ttt1)  (progn (setq  js (+ js 1))
                        ;     (princ "\ni=")(princ i)(princ " ttt=")(princ ttt)
                         ;    (princ " ttt1=")(princ ttt1)
                        ; (princ "\n aa=")(princ aa)(princ " js=")(princ js)
                      )
                      (progn
                            ;(princ "\naa=")(princ aa)(princ "  js=")(princ js)  
                             (setq txt1 (substr txt$ (- i js) (+ js 1)))
                            ; (princ "  txt1=")(princ txt1)
                             (cond ((= ttt 1) (setq txt1$ (cons txt1 txt1$ )))
                                   ((= ttt 0) (setq txt2$ (cons txt1 txt2$ )))
                             )
                             (setq txt3$ (cons txt1 txt3$))
                             (setq js 0 aa (+ i 1))   
                      )
   )
   
   )
  (setq txt txt$)
  (setq txt1$ (REVERSE txt1$) TXT2$ (reverse txt2$) TXT3$ (reverse txt3$))
;   (princ txt1$)(princ txt2$)(princ txt3$)
;   (princ zf)
  (setq n1 (length txt1$))
  (setq n2 (length txt2$))
  (setq n3 (length txt3$))
)

dcl文件
ddt:dialog{fixed_width=true;
    label="字符修改";
   :row{ fixed_width=true;
    :column{:edit_box{key="text1";}
            :row {key="j1";:button{label="-";key="jian1";}
                  :button{label="+";key="jia1";}
                 }
           }
    :column{:edit_box{key="text2";}
            :row {key="j2";:button{label="-";key="jian2";}
                  :button{label="+";key="jia2";}
                 }
           }
    :column{:edit_box{key="text3";}
            :row {key="j3";:button{label="-";key="jian3";}
                  :button{label="+";key="jia3";}
                 }
           }
    :column{:edit_box{key="text4";}
            :row {key="j4";:button{label="-";key="jian4";}
                  :button{label="+";key="jia4";}
                 }
           }
    :column{:edit_box{key="text5";}
            :row {key="j5";:button{label="-";key="jian5";}
                  :button{label="+";key="jia5";}
                 }
           }
   :column{:edit_box{key="text6";}
            :row {key="j6";:button{label="-";key="jian6";}
                  :button{label="+";key="jia6";}
                 }
           }
      
    :column{:edit_box{key="text7";}
            :row {key="j7";:button{label="-";key="jian7";}
                  :button{label="+";key="jia7";}
                 }
           }
      
    :column{:edit_box{key="text8";}
            :row {key="j8";:button{label="-";key="jian8";}
                  :button{label="+";key="jia8";}
                 }
           }
    :column{:edit_box{key="text9";}
            :row {key="j9";:button{label="-";key="jian9";}
                  :button{label="+";key="jia9";}
                 }
           }
       }  
   
   :row {
         :edit_box{label="原字符";key="zf";fixed_width=true;width=80;allow_accept=true;}
         :boxed_row {:radio_button{label="修改";key="ch";}
                     :radio_button{label="移动";key="mo";}
                     :radio_button{label="拷贝";key="cp";}
                    }
        }  
ok_cancel;

}

PFD8667

不知在CAD2006版能不能用,要币还是不敢下载了.

steven009

在2004下可以用

smile313

好东西，改梁集中标注提高效率

bsq

好是好，可是有一个遗憾，就是回车不能结束？

andyhua5240

最初由 PFD8667 发布
[B]不知在CAD2006版能不能用,要币还是不敢下载了. [/B]

回楼上的，CAD2006完全能用。
只是不支持回车确认退出？
遗憾！

shq197528

也是麻烦的事呀!

zh_6531394

字符太多了就运行不起来?

xjlmlxbq

有源码，不错,下了

2491444

好

glmyyy

不错,大大提高效率,可惜要收...