连续模设计相关技术及AutoCAD二次开发lisp

哦，误会，误会，因为你的源程序与我用的TWCAD里的差不多，也就。。。

你很牛，居然能看到TWCAD的源程序！

我认为开的比较成功的一套模，与大家分享，希望大家多提议见

明天发生成孔表的程序，已做通用化处理，再贴点图。
好像大家的兴趣不高啊，不会大家都是菜鸟吧

全自动标注模板孔

模板自动对齐坐标标注

[ 本帖最后由 chenjian1 于 2006-2-8 14:43 编辑 ]

c:WORD 常用词库(可修改词库文件wordlist*.txt)

c:WORD 常用词库(可修改词库文件wordlist*.txt)


LISP文件
;;;********************************************************************1
;;;常用词词库
;;;command: WORD
;;;2006-01-19     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:WORD (/ inspt            mlist1         mlist2              word_list1
               word_list2   pophh_list         popang_list  wordstr
              data1 data2 ff)
  (setvar "cmdecho" 0)
  (setq oldsty (Getvar "textstyle"))
  (setq mlist1 nil)
  (setq mlist2 nil)
  (setq        ff
         (open "D:\\DIE-DES\\BLOCK\\wordlist1.txt"
               "r"
         )
  )
  (setq data1 (read-line ff))
  (while data1
    (setq mlist1 (cons data1 mlist1))
    (setq data1 (read-line ff))
  )
  (close ff)
  (setq        ff
         (open "D:\\DIE-DES\\BLOCK\\wordlist2.txt"
               "r"
         )
  )
  (setq data2 (read-line ff))
  (while data2
    (setq mlist2 (cons data2 mlist2))
    (setq data2 (read-line ff))
  )
  (close ff)
  (setq        word_list1
         (reverse mlist1)
  )
  (setq        word_list2
         (reverse mlist2)
  )
  (setq pophh_list '("1.5" "2" "2.5" "3" "3.5" "5" "10"))
  (setq popang_list '("0" "45" "90" "-45"))
  (chk_style)
  (dcl_word)
  (setvar "textstyle" oldsty)
  (prin1)
)
(defun dcl_word        ()
  (setq dcl_id (load_dialog "word"))
  (new_dialog "word" dcl_id)
  (show_list "klist1" word_list1)
  (show_list "klist2" word_list2)
  (show_list "pophh" pophh_list)
  (show_list "popang" popang_list)
  (action_tile "klist1" "(sub_klist1 $value)")
  (action_tile "klist2" "(sub_klist2 $value)")
  (action_tile "pophh" "(sub_pophh $value)")
  (action_tile "popang" "(sub_popang $value)")
  (action_tile "accept" "(ok_word)(done_dialog 1)")
  (set_tile "txthh" (rtos  (getvar "textsize") 2 1))
  (set_tile "txtang" "0")
  (setq dd (start_dialog))
  (if (and (= dd 1) (/= wordstr ""))
    (progn
      (setvar "textsize" (atof txthh))
      (setq inspt (getpoint "文字写入点:"))
      (if inspt
        (command "text" inspt txthh txtang wordstr)
        (Princ "\n---未指定写入点,操作取消!---")
      )
    )
    (Princ "\n---未写入任何文字---")
  )
  (Princ
    "\n---Bye c:WORD 常用词库(可修改词库文件wordlist*.txt)---"
  )
)


DCL文件
word:dialog{
label="常用词";
:row{
:list_box{
label="词库1";
key="klist1";
width=20;
height=30;
fixed_width_font=true;
}
:list_box{
label="词库2";
key="klist2";
width=20;
height=30;
fixed_width_font=true;
}}
:edit_box{label="组合 ";key="wordstr";height=1.3;}
:row{
fixed_width=true;
alignment=centered;
:edit_box{label="字高";key="txthh";edit_width=4;}
:popup_list{        //下拉选单1
key="pophh";
edit_width=4;
}
:edit_box{label="角度";key="txtang";edit_width=4;}
:popup_list{        //下拉选单2
key="popang";
edit_width=4;
}
}
spacer_1;
ok_cancel;
}

;;;取得任意两点之间的中点，作φ2.1穿线孔


;;;********************************************************************1
;;;取得任意两点之间的中点，作φ2.1穿线孔 Command:zdd
;;;Version 1.0
(defun c:zdd (/ pt1 i)
  (setvar "cmdecho" 0)
  (sub-chk-layer1 chklay)
  (setq pt1 (get-midpt pt1 pt2))        ;取得任意两点之间的点
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (command "circle" pt1 "d" 2.1)
  (command "change" (entlast) "" "p" "c" "11" "")
  (setvar "osmode" os)
  (princ
    "\n----------Bye c:ZDD 取得中点,作φ2.1穿线孔!---------"
  )
  (prin1)
)

计算展开长度,绘制展开线

;;;********************************************************************1
;;;计算展开长度,绘制展开线
;;;command: ZKL
;;;2005-12-24     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:ZKL (/ en1 en1-data en1-ccolor ss i sum en dd h pt area)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq ss (ssget))
  (if ss
    (progn
      (setq i 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq en (ssname ss i))
        (command "lengthen" en "")
        (setq dd (getvar "perimeter"))
        (setq sum (+ sum dd))
        (setq i (1+ i))
      )
      (command "LINE" "0,0" (list sum 0) "")
      (command "change" (entlast) "" "p" "c" 2 "")
      (setq oldORTHOMODE (getvar "ORTHOMODE"))
      (setvar "ORTHOMODE" 0)
      (Princ "\n请选择放置点...")
      (command "MOVE" (entlast) "" '(0 0) PAUSE)
      (setvar "ORTHOMODE" oldORTHOMODE)
      (princ (strcat "\n展开长度=" (rtos sum 2)))
    )
  )
  (command "undo" "e")
  (Princ
    "\n---------------Bye c:ZKL 计算展开长度,绘制展开线---------------"
  )
  (prin1)
)