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

LZ，我加载不成功是什么原因。
我的是2004

命令: _appload 已成功加载 des.VLX。
命令:
「Die-Des五金连续模设计」(AutoCAD2002-2005) V20060303
不可使用本软件.如有建议请E-mail:ChenJianCaiHong@163.com; 错误: quit / exit abort
命令:

把 Die-Des-Pass.lic 内的内容发个我看看我才知道

楼主是高手！只有佩服的份了！支持你！

高手,

楼主，谢谢！我全部看完了，受益非浅，我的QQ是242515616， 有机会咱们聊聊

可以参考

;;;********************************************************************1
;;;文字对齐  Command:ALTEXT
;;;2004-05-18     Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:altext        (/         ss         pt1         i         enname         endata
                 texthight         txt         txtsty         txtlen         newtxt
                 txt1         txt4         txt5
                )
  (command "undo" "be")
  (princ "\n请顺序选择要对齐的文字...")
  (setq        ss (ssget
             '(
               (-4 . "<XOR")
               (0 . "text")
               (0 . "mtext")
               (-4 . "XOR>")
              )
           )
  )                ;创建文字对象的选择集text or mtext

  (if (null ss)
    (sub-quit)
  )
  (setq pt1 (GETPOINT "\nPlease enter the base point:"))
  (if (null pt1)
    (sub-quit)
  )

  (setq i 0)
  (repeat (sslength ss)
    (setq enname (ssname ss i))
    (setq endata (entget enname))
;;;(setq textbasept (cdr (assoc 10 endata)))
    (setq texthight (cdr (assoc 40 endata)))
    (setq txt (cdr (assoc 1 endata)))        ; 取得原字符串
    (setq txtsty (cdr (assoc 7 endata))) ; 取得原字符串样式
    (setq txtlen (strlen txt))
    (setq txt1 (substr txt 1 1))        ; 取得原字符串子串1
    (setq txt4 (substr txt 4 1))        ; 取得原字符串子串4
    (setq txt5 (substr txt 5 (- txtlen 4))) ; 取得原字符串子串5---
    (setq i (1+ i))
    (if        (and (= txt1 "<") (= txt4 ">"))
      (if (< i 10)
        (setq newtxt (strcat "<0" (rtos i 2 0) ">" txt5)) ;新字符串
        (setq newtxt (strcat "<" (rtos i 2 0) ">" txt5)) ;新字符串
      )
      (if (< i 10)
        (setq newtxt (strcat "<0" (rtos i 2 0) ">" txt)) ;新字符串
        (setq newtxt (strcat "<" (rtos i 2 0) ">" txt))
      )                                        ;新字符串
    )
    (command "text" "s" txtsty pt1 texthight 0 newtxt)
    (setq pt1 (polar pt1 (* pi 1.5) (+ texthight 1.5)))
  )
  (command "erase" ss "")
  (command "undo" "e")
  (Princ "\n---------------Bye c:AlText 文字对齐--------------")
  (prin1)
)

可以請  chenjian1 兄上傳"全自动标注模板孔"及"模板自动对齐坐标标注"的lisp的程序嗎?因為我急需要用到,感謝不盡^^

可以拜託chenjian1 兄幫我修改一下lisp好嗎?
此lisp只能讀取一班的圓形座標,可以修改成讀取block插入點座標嗎?不用標直徑
還有編號可以修改放在右上角嗎?
謝謝^^

好久没发了
;;;********************************************************************1
;;零件位置圆整  Command:FixPart
;;;2005-10-17    Chen Jian
;;;Version 1.1   Change in UCS
;;;2005-09-16    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:FixPart (/              en1          en1-data    en1-type
                  direction   INSERT-name INSERT-data INSERT-cenpt
                  cptx              cpty          newcptx     newcpty
                  os              i
                 )
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq en1 (entsel "\n选取要调整位置的零件(图块)... "))
  (setq direction nil)
  (setq i 1)
  (while en1
;;;当en1存在时，做以下内容，直到en1不存在为止
    (setq en1-data (entget (car en1)))
    (setq en1-type (cdr (assoc 0 en1-data))) ;群码0为对象类型
    (if        (= en1-type "INSERT")
      (sub-move-INSERT en1)
      (Princ "\n**************Sorry,不能调整此对象!")
    )
    (setq en1 (entsel "\n选取要调整位置的零件(图块)... "))
  )
  (command "undo" "e")
  (Princ "\n---------------Bye c:FixPart 零件位置圆整---------------")
  (prin1)
)

(defun sub-move-INSERT (en1)
  (if (null direction)
    (setq
      direction
       (getint "\n请选择方向 [X方向(1)/Y方向(2)/XY方向(3)]<3>:")
    )
  )
  (if (and (/= direction 1) (/= direction 2))
    (setq direction 3)
  )
  (setq INSERT-name (car en1))
  (setq INSERT-data (entget INSERT-name))
  (setq INSERT-cenpt (cdr (assoc 10 INSERT-data))) ;求得圆心pt
  (setq INSERT-cenpt(trans INSERT-cenpt 0 1))             ;转为ucs
  (setq cptx (car INSERT-cenpt))        ;求得圆心pt的x坐标
  (setq cpty (cadr INSERT-cenpt))        ;求得圆心pt的y标
  (setq newcptx (fix cptx))                ;求得圆心pt的新x坐标
  (setq newcpty (fix cpty))                ;求得圆心pt的新y坐标
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (Princ (strcat "\n" "零件" (rtos i 2 0)))
  (if (= direction 1)
    (progn
      (command "move"
               INSERT-name
               ""
               (list cptx cpty)
               (list newcptx cpty)
      )
      (Princ "\调整了X方向*X")
    )
  )
  (if (= direction 2)
    (progn
      (command "move"
               INSERT-name
               ""
               (list cptx cpty)
               (list cptx newcpty)
      )
      (Princ "\调整了Y方向**Y")
    )
  )
  (if (= direction 3)
    (progn
      (command "move"
               INSERT-name
               ""
               (list cptx cpty)
               (list newcptx newcpty)
      )
      (Princ "\调整了XY方向***XY")
    )
  )
  (setq i (1+ i))
  (setvar "osmode" os)
)