我的词库

linheyuanpcb

print1985 发表于 2012-5-14 10:58
易语言的也能插入到cad？
能否共享下e的代码呢 真是高人啊

易+lisp实现的

print1985

linheyuanpcb 发表于 2012-5-14 11:10
易+lisp实现的

能再说具体点吗 lsp怎样调用e e怎样插入cad呢 中间的参数靠啥传递呢

linheyuanpcb

print1985 发表于 2012-5-14 11:19
能再说具体点吗 lsp怎样调用e e怎样插入cad呢 中间的参数靠啥传递呢

其实就一句代码
(command "text" point 字高 角度 当前文字 "')
易与cad接口摆渡下就有了,
在这里就不方便说这个，只讨论lisp类的

print1985

十分感谢linheyuanpcb兄台 我去学习下 不懂的地方希望能得到你的指点

LLXXZZ

分享是一种 境界...楼主.

linheyuanpcb

增加捨取添加

exe程序,可能会报毒，只对04有效

tianyi1230

谁有lsp的源码词库，发上来学习学习

自贡黄明儒

linheyuanpcb 发表于 2012-5-15 11:43
增加捨取添加

exe程序,可能会报毒，只对04有效

这是什么语言写的呀，在cad下怎么用？

sqqr

应该是易语言写的

lisone

;        =============================
;        |     词库插入t5                 |
;        |                                |
;        =============================


(defun delsame (list0) (if list0 (cons (car list0) (delsame (vl-remove (car list0) list0)))))

(defun fwrdlist (list0 n)(reverse (cdr (member (nth n list0) (reverse list0)))))

(defun backlist (list0 n)(cdr (member (nth n list0) list0)))
(defun swapfwrd (list0 n)
  (if (and (>= (1- n) 0) (> (length crtlst) n))
    (setq list0 (append (fwrdlist list0 (1- n)) (list (nth n list0) (nth (1- n) list0)) (backlist list0 n)))
  )list0)

(defun swapback (list0 n)
  (if (and (>= n 0) (> (length crtlst) (1+ n)))
    (setq list0 (append (fwrdlist list0 n) (list (nth (1+ n) list0) (nth n list0)) (backlist list0 (1+ n))))
  )list0)

(defun add_item (list0 n item)
  (if (and (>= n 0) (> (length crtlst) n))
    (append (fwrdlist list0 n) (list item (nth n list0)) (backlist list0 n))))

(defun del_item (list0 n)
  (if (and (>= n 0) (> (length crtlst) n))
    (append (fwrdlist list0 n) (backlist list0 n))))

(defun mdfylist (list0 n item)
  (if (and (>= n 0) (> (length crtlst) n))
    (append (fwrdlist list0 n) (list item) (backlist list0 n))))

(defun readfn (/ fn ftext crtlst)
  (setq fn (open (findfile "t6.ini") "r"))
  (while (setq ftext (read-line fn)) (setq crtlst (append crtlst (list ftext))))
  (close fn)
  (setq textstr (nth 0 crtlst))
  crtlst)

(defun writefn (crtlst / fn)
  (setq fn (open (findfile "t6.ini") "w"))
  (foreach x crtlst (write-line x fn))
  (close fn))

(defun updlst (key lst /)
  (start_list key 3)
  (mapcar 'add_list lst)
  (end_list))

(defun do_list (key / n)
  (setq n (atoi (get_tile key)))
  (setq textstr (nth n crtlst))
  (cond
    ((= key "itemlist")
      (if (= (length crtlst) (1+ n))(mode_tile "down" 1)(mode_tile "down" 0))
      (if (= n 0)(mode_tile "up" 1)(mode_tile "up" 0))
      (set_tile "item" textstr)
      (mode_tile "item" 2)
    )
    ((= key "itemlist0")
      (if (= (length crtlst0) (1+ n))(mode_tile "down0" 1)(mode_tile "down0" 0))
      (if (= n 0)(mode_tile "up0" 1)(mode_tile "up0" 0)))))

(defun mdfitem (/ n textstr)
  (setq n (atoi (get_tile "itemlist")) textstr (get_tile "item"))
  (setq crtlst (mdfylist crtlst n textstr))
  (writefn crtlst)
  (updlst "itemlist" crtlst)
  (set_tile "itemlist" (itoa n))
  (do_list "itemlist"))

(defun additem ()
  (setq crtlst (add_item crtlst (atoi (get_tile "itemlist")) (get_tile "item")))
  (writefn crtlst)
  (updlst "itemlist" crtlst)
  (set_tile "itemlist" "0")
  (do_list "itemlist"))

(defun delitem ()
  (setq crtlst (del_item crtlst (atoi (get_tile "itemlist"))))
  (writefn crtlst)
  (updlst "itemlist" crtlst)
  (set_tile "itemlist" "0")
  (do_list "itemlist"))

(defun upitem (/ n textstr0 val)
  (if (> (setq n (atoi (get_tile "itemlist"))) 0)
    (progn
      (setq crtlst (swapfwrd crtlst n))
      (writefn crtlst)
      (updlst "itemlist" crtlst)
      (set_tile "itemlist" (itoa (1- n)))
      (do_list "itemlist"))))

(defun downitem (/ n)
  (if (< (setq n (atoi (get_tile "itemlist"))) (1- (length crtlst)))
    (progn
      (setq crtlst (swapback crtlst n))
      (writefn crtlst)
      (updlst "itemlist" crtlst)
      (set_tile "itemlist" (itoa (1+ n)))
      (do_list "itemlist"))))

(defun upitem0 (/ n)
  (if (> (setq n (atoi (get_tile "itemlist0"))) 0)
    (progn
      (setq crtlst0 (swapfwrd crtlst0 n))
      (updlst "itemlist0" crtlst0)
      (set_tile "itemlist0" (itoa (1- n)))
      (do_list "itemlist0"))))

(defun downitem0 (/ n val temp)
  (if (< (setq n (atoi (get_tile "itemlist0"))) (1- (length crtlst0)))
    (progn
      (setq crtlst0 (swapback crtlst0 n))
      (updlst "itemlist0" crtlst0)
      (set_tile "itemlist0" (itoa (1+ n)))
      (do_list "itemlist0"))))

(defun addlist ()
  (setq crtlst0 (delsame (append crtlst0 (list (get_tile "item")))))
  (updlst "itemlist0" crtlst0)
  (set_tile "itemlist0" (itoa (1- (length crtlst0))))
  (mode_tile "removelist" 0)
  (do_list "itemlist0"))

(defun removelist (/ n)
  (setq n (atoi (get_tile "itemlist0")))
  (setq crtlst0 (del_item crtlst0 n))
  (updlst "itemlist0" crtlst0)
  (set_tile "itemlist0" "0")
  (if (null crtlst0)(mode_tile "removelist" 1))
  (do_list "itemlist0"))

(defun tolib (/ ss fn n txt)
  (setq ss (ssget '((0 . "text"))) do_what nil)
  (if ss
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq crtlst (append crtlst (list (cdr (assoc 1 (entget (ssname ss n)))))) n (1+ n))
      )
      (setq crtlst (delsame crtlst))
      (writefn crtlst)
      (updlst "itemlist" crtlst)
    )
  )
  (setq crtlst0 nil)
  (princ))







(defun c:t6 (/ textstr0 scl DLG_ID index result crd crtlst n crtlst0 kd do_what)
(setq flag 4)


  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq syserr *error* *error* '(nil (princ))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (setq scl (getvar "dimscale"))
  (setq txtfile (findfile "t6.ini"))
  (setq txtlist (Get_Txt txtfile))
  (setq crtlst (readfn))
                       

(setq DLG_ID (load_dialog "t6.dcl"))
(if (< DLG_ID 0) (exit))

     (while (and (/= result 1) (/= result 0))                  
     (if (= do_what 3) (tolib))
(if (not (new_dialog "teclib" DLG_ID))(exit))


;;;--------------------------------------------------;;;
          (progn                                                      
          (updlst "itemlist" crtlst)
          (set_tile "itemlist" "0")
          (set_tile "item" textstr)
          (mode_tile "item" 2)
          (mode_tile "up" 1)
          (mode_tile "up0" 1)
          (mode_tile "down0" 1)
          (if (null crtlst0)(mode_tile "removelist" 1))
          (action_tile "itemlist" "(do_list \"itemlist\")")
          (action_tile "item" "(setq textstr $value)")
          (action_tile "mdf" "(mdfitem)")
          (action_tile "add" "(additem)")
          (action_tile "del" "(delitem)")
          (action_tile "up" "(upitem)")
          (action_tile "down" "(downitem)")
          (action_tile "itemlist0" "(do_list \"itemlist0\")")
          (action_tile "addlist" "(addlist)")
          (action_tile "removelist" "(removelist)")
          (action_tile "up0" "(upitem0)")
          (action_tile "down0" "(downitem0)")
          (action_tile "pick" "(setq do_what 3)(done_dialog)")
          (action_tile "accept" "(setq result 1)(done_dialog)")
          (action_tile "cancel" "(setq result 0)(done_dialog 0)")
          (action_tile "itemlist" "(itemlist $value)")
          (action_tile "wbxz" "(wbxz0)(done_dialog 1)")
          (action_tile "aa2" "(aa20)(done_dialog 2)")
          (setq flag (start_dialog))
           (if (= flag 1) (wbxz itemn txtlist))
          (if (= flag 2) (aa2 itemn txtlist))
          (start_dialog)
           )
;;;--------------------------------------------------------------;;;
(unload_dialog DLG_ID)
)

  (if (and (= result 1) (setq crd (getpoint "\n文本位置:")))
    (if crtlst0
      (progn
        (setq n 0 textstr0 "")
        (repeat (length crtlst0)
          (setq textstr0 (strcat textstr0 (itoa (1+ n)) ". " (nth n crtlst0) "\\P"))
          (setq n (1+ n))
        )
        (vl-string-right-trim "\\P" textstr0)
        (setq kd (getcorner crd "\n段落宽:"))
        (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity")'(100 . "AcDbMText")(cons 10 crd)(cons 40 (* scl 3.5))(cons 41 (- (car kd)(car crd)))'(71 . 1)'(72 . 5)(cons 1 textstr0)'(8 . "TEXT")))
        (entmake (list '(0 . "TEXT")'(10 0.0 0.0 0.0)(cons 40 (* scl 5.0))'(72 . 1)'(73 . 1)(cons 11 (list (/ (+ (car crd)(car kd)) 2.0) (+ (cadr crd)(* 4.0 scl)) 0.0))'(1 . "加工说明")'(8 . "TEXT")))
      )
      (entmake (list '(0 . "TEXT")(cons 10 crd)(cons 40 (* scl 3.5))(cons 1 textstr)'(8 . "TEXT")))
    )
  )
  (setq *error* syserr)
  (command "undo" "e")
(princ)
)



(defun itemlist(vva)
(setq itemn (nth (atoi vva) txtlist))
(set_tile "item" itemn)
)

(defun wbxz0()
(setq itemn (get_tile "item")))

(defun aa20()
(setq itemn (get_tile "item")))

(if (= lit 1)

(defun wbxz0()
(setq itemn (get_tile "item")))

(defun wbxz (itemn txtlist  / ent1 ent2)
(if txtlist (write_Txt txtfile txtlist))
(vl-load-com)
(setq ent1 (vlax-ename->vla-object (car (entsel))))
(setq ent2 (vla-put-textstring ent1 itemn))
)
)

(if (= lit 2)
(defun aa20()
(setq itemn (get_tile "item")))
(defun aa2 (itemn txtlist  / ent1 ent2)
(command "leader" pause pause "" "" "" itemn  ""))
)




;;将文本文件中的内容转换为列表
(defun Get_Txt (datfile / tmplst x fn)
  (setq fn (open datfile "r"))
  (while (setq x (read-line fn))
        (setq tmplst(append tmplst(list x)))
       )
     (close fn)
  tmplst
)
;;将列表内容写入文本文件中
(defun write_Txt (datfile tmplst / x fn)
  (setq fn (open datfile "w"))
  (setq n 0)
  (while (setq x (nth n tmplst))
    (write-line x fn)
    (setq n (+ n 1))
  )
  (close fn)
)
;;;把列表添入菜单中
(defun additems (listbox tmplst)
(start_list listbox)
(mapcar 'add_list tmplst)
(end_list)
)


//////////////////////DCL//////////////
teclib :dialog
{
  label="LISAN制作";


  :boxed_row
  {
    label="词库";

  :boxed_row
  {
   label="词库种类";
      :list_box
      {
        key="li";
        value="0";
        width=30;
        height=30;
        fixed_width=true;
        allow_accept=true;
        value="0";
      }
      }

    :column
    {

   label="词库内容";
      :list_box
      {
        key="itemlist";
        value="0";
        width=30;
        height=30;
        fixed_width=true;
        allow_accept=true;
        value="0";
      }
      :edit_box
      {
        key="item";
        width=20;
        allow_accept=true;
      }
      spacer;
    }
    :column
    {
      fixed_width = true;
      alignment = centered;
      :button
      {
        label="添加";
        key="add";
        fixed_width=true;
      }
      :button
      {
        label="删除";
        key="del";
        fixed_width=true;
      }
      :button
      {
        label="上移";
        key="up";
        fixed_width=true;
      }
      :button
      {
        label="下移";
        key="down";
        fixed_width=true;
      }
      :button
      {
        label="修改";
        key="mdf";
        fixed_width=true;
      }
    }

  :boxed_row
  {
    label="加工说明";
    :list_box
    {
      key="itemlist0";
      value="0";
      width=30;
      height=10;
      fixed_width=true;
      value="0";
    }
    :column
    {
      fixed_width=true;
      alignment = centered;
      :button
      {
        label="加入";
        key="addlist";
        fixed_width=true;
      }
      :button
      {
        label="去除";
        key="removelist";
        fixed_width=true;
      }
      :button
      {
        label="上移";
        key="up0";
        fixed_width=true;
      }
      :button
      {
        label="下移";
        key="down0";
        fixed_width=true;
      }
    }
  }
  }
  :row
  {
:button{
      label="添加入库";
      key="pick";
      fixed_width=true;
      width=20;}
:button{
     label="选择需替换的文本";
     key="wbxz";
     fixed_width = true;
     width=20;}
:button{
     label="选择引线标注文本";
     key="aa2";
     fixed_width = true;
     width=20;}
    ok_cancel;
  }


}