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

自动标注模孔坐标

;;;********************************************************************1
;;;自动标注模孔坐标
;;;command: AD
;;;2004-01-13     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:ad (/ ss xx chkdim os i en1 en1-data pt rad pty)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq ss (ssget '((0 . "CIRCLE"))))        ;创建圆对象的选择集
  (if (null ss)
;;;    (sub-quit)
    (Princ "\n---无对象哦!")
    (progn
      (setq xx "autodim")
      (sub-chk-style chksty)
      (setvar "TEXTSTYLE" "autodim")
      (setq chkdim (tblsearch "dimstyle" "autodim"))
      (if (= chkdim nil)
        (command "dimstyle" "s" "autodim")
      )
      (setvar "DIMTXSTY" "autodim")
      (setq os (getvar "osmode"))
      (setvar "osmode" 0)
;;;      (command "ucs" "")
      (setq i 0)
      (repeat (sslength ss)
        (setq en1 (ssname ss i))
        (sub-dim en1)
        (setq i (1+ i))
      )
      (setq ss nil)
      (setvar "osmode" os)
;;;      (command "ucs" "p")
    )
  )
  (command "undo" "e")
  (Princ
    "\n---------------Bye c:AD 自动标注模孔坐标---------------"
  )
  (prin1)
)

此为一快速开孔程式，（公夹板，脱料背板+1.0/s，脱料板）,如果图层名不一样须自行修改

;;;************************************************************************E
;;;向下成形制作>上模  Command:ShapeU1
;;;Shape punch
;;;2004-02-07     Chen Jian
;;;MADE IN CHINA
(defun C:ShapeU1(/ en1 en1-data en1-type os)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq en1 (entsel "\n選取成形公外形... "))
  (while en1        ;;;當en1存在時，做以下迴圈內容，直到en1不存在止
    (setq en1-data (entget (car en1)))
    (setq en1-type (cdr (assoc 0 en1-data)))            ;群碼0為對象類型
    (if (= en1-type "LWPOLYLINE")(sub-shapeu-LWPOLYLINE1))
    (if (= en1-type "CIRCLE")(sub-shapeu-circle1))
    (setq en1 (entsel "\n選取成形公外形... ")))
    (setvar "osmode" os)
    (command "undo" "e")
  (Princ "\n---------------Bye c:ShapeU1 向下成形制作>上模---------------")
  (prin1)
  )
(defun sub-shapeu-LWPOLYLINE1()
  (sub-chk-layer1 chklay)
  (command "change" en1 "" "p" "la" "layout" "C" "2" "")
  ;;;05-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "05-01" "c" "1" "")     ;Color is red
  ;;;06-01
  (command "offset" "1" en1 "-1000,-1000" "")
  (command "change" (entlast) "" "p" "la" "06-01" "c" "3" "")     ;Color is green
  ;;;07-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "07-01" "c" "1" "")     ;Color is red
  (princ "\n******{07-->>05} [ShapeU1 OK!]******")
  )
(defun sub-shapeu-circle1()
  (sub-chk-layer1 chklay)
  (command "change" en1 "" "p" "la" "layout" "C" "2" "")
  ;;;05-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "05-01" "c" "1" "")     ;Color is red
  ;;;06-01
  (command "offset" "1" en1 "-1000,-1000" "")
  (command "change" (entlast) "" "p" "la" "06-01" "c" "7" "")     ;Color is black
  ;;;07-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "07-01" "c" "1" "")     ;Color is red
  (princ "\n******{07-->>05} [ShapeU1 OK!]******")
  )

模板外形生成1


;;;********************************************************************1
;;;模板外形生成1  Command:plant1
;;;2004-02-02     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:plant1(/ en1 en1-data en1-type layname)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq en1 (entsel "\n請選擇基板... "))
  (if en1     ;;;當en1存在時，做以下
    (progn
      (setq en1-data (entget (car en1)))
      (setq en1-type (cdr (assoc 0 en1-data)))            ;群碼0為對向類型
      (if (= en1-type "LWPOLYLINE")(sub-plant1)(sub-quit))
      ))
  (command "undo" "e")
  (Princ "\n---------------Bye clant1 模板外形生成1---------------")
  (prin1)
  )

(defun sub-plant1()
   (sub-chk-layer1 chklay)
   (setq i 2)
   (while (< i 8)
      (if (= i 2)(setq layname "08-01"))
      (if (= i 3)(setq layname "07-01"))
      (if (= i 4)(setq layname "06-01"))
      (if (= i 5)(setq layname "05-01"))
      (if (= i 6)(setq layname "01-01"))
      (if (= i 7)(setq layname "02-01"))
       (command "copy" en1 ""  "0,0" "")
       (command "change" (entlast) "" "p" "la" layname "")
      (setq i (+ i 1))
  )
)

單行文字加圓


;;;********************************************************************1
;;;單行文字加圓 command c:txtcir
;;;2004-05-18     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:txtcir(/ dd ss i ssn ssdata sstyp box p1 p2 p3 p4 dda cen)
  (setvar "cmdecho" 0)
  (setq dd (getdist "\n輸入字間與圓周距離<1.5>: "))
  (if (null dd)
    (setq dd 1.5)
    )
  (setq ss (ssget))
  (if (null ss)(sub-quit))
  (setq i 0)
  (repeat (sslength ss)
    (setq ssn (ssname ss i))
    (setq ssdata (entget ssn))
    (setq sstyp (cdr (assoc 0 ssdata)))
    (if        (= sstyp "TEXT")
      (progn
        (command "ucs" "e" ssn)
        (setq box (textbox ssdata))
        (setq p1 (car box))
        (setq p3 (cadr box))
        (setq p2 (list (car p3) (cadr p1)))
        (setq p4 (list (car p1) (cadr p3)))
        (setq dda (+ (/ (distance p1 p2) 2) dd))
        (setq cen (inters p1 p3 p2 p4))
        (setq os (getvar "osmode"))
        (setvar "osmode" 0)
        (command "circle" cen dda)
        (setvar "osmode" os)
        (command "ucs" "P" )
        )
      )
    (setq i (1+ i))
    )
  (Princ "\n---------------Bye c:TxtCir 單行文字加圓--------------")
  (prin1)
  )

做多線段的倒圓角



;;;********************************************************************1
;;;The line to FILLET
;;;做多線段的倒圓角  comma: FA
;;;2004-06-01    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:fa (/ rad)
  (setvar "cmdecho" 1)
    (command "FILLET" "R" pause)
    (command "FILLET" "P" PAUSE)
  (Princ "\n---------------Bye c:FA---------------")
  (prin1)
)

楼主,请传自动完成模板说明的程式及尺寸标注对齐的程式,注明那CAD那个版本可用

尺寸标注对齐的程式 还没有 上面已有 对齐标注尺寸 的程式
大部分不用到vlx 扩展命令的程序可在AutoCAD2000-2005中使用
所有程序可在2005中使用

自动完成模板说明要根具具体的模具结构和要的样式来设计 ，我用的可能不适合你，你要说说你的要求

頂........

这段时间没上来发东西，我搞了一个连续模个人论坛，感觉不是很爽，等我辞工到期再好好搞一下
如果哪位朋友有经验可以分享一下

看来真正在厂里搞模具设计，有时间上论坛的人并不多，能提意见的太少了