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

下不了，发到我的邮箱吧

原帖由 corw 于 2006-8-23 20:17 发表
可以拜託chenjian1 兄幫我修改一下lisp好嗎?
此lisp只能讀取一班的圓形座標,可以修改成讀取block插入點座標嗎?不用標直徑
還有編號可以修改放在右上角嗎?
謝謝^^

发到我邮箱吧

請chenjian1 兄看看

(defun c:cd()
(setq j1 0)
(setq TEXT (getvar "TEXTSTYLE"))
(setvar "TEXTSTYLE" "standard")
(setq p0 (getpoint"\n請確定圓心座標中心點:"))
(command "ucs" "o" p0)
(setq u (getpoint"\n請確定座標表插入點:"))
(setq j0 (getint "\n請確定坐標小數點保留位數<2>:"))
(if ( = j0 nil)
  (setq j0 2))
(setq j1 (getint "\n請確定字高<3.5>:"))
(if ( = j1 nil)
  (setq j1 3.5))
(setq j2 (getstring "\n<E.P.T.M>:"))
(if ( = j2 nil)
  (setq j2 "E"))
(setq l 0)
(setq t0(ssget))
(setq i 0)
(setq t2 nil)
(setq t6 nil)
(repeat (sslength t0)
    (setq t1 (entget (ssname t0 l)))
    (setq e1(cdr(assoc '0 t1)))
    (if (= e1 "CIRCLE")
       (progn
          (setq r1 (cdr (assoc '40 t1)))
          (setq t3 (list r1))
          (setq t2 (append t3 t2))
          (setq i (+ 1 i))
       )
    )      
    (setq l (+ 1 l))
)
(setq n i )
(repeat i
   (setq m 0 )
   (setq t3 (car t2))
   (repeat n
       (setq t4 (nth m t2))
       (if (> t4 t3 )
           (setq t3 t4))
       (setq m(+ 1 m))
   )
   (setq t2(subst 0 t3 t2))
   (if ( /= t3 0 )
      (progn
         (setq t5 (list t3))
         (setq t6 (append t5 t6))
      )
  )
)
(setq x0 (getvar "osmode"))
(setvar "osmode" 0)
(setq d 0)
(setq n3 0)
(setq ttt(length t6))
(setq n 0)
(repeat ttt
           (setq a(nth n t6))
           (setq p2 nil)             
           (setq l 0)
           (repeat (sslength t0)
                  (setq t1(entget (ssname t0 l)))
                  (setq e1(cdr(assoc '0 t1)))
                  (if (= e1 "CIRCLE")
                      (progn
                        (setq ff(cdr(assoc '40 t1)))
                      (if (= ff a)
                      (progn
                        (setq p1 (cdr (assoc '10 t1)))
                        (setq p3 (list p1))
                        (setq p2 (append p3 p2))                     
                      ))
                  ))
                  (setq l (+ 1 l))
           )
           (setq tt(length p2))
           (if (= tt 1)
             (progn
                 (setq p2(subst nil p1 p2))
                 (setq p6 (trans p1 0 1))
                 (setq n3(+ n3 1))
                 (setq n4(strcat j2 (itoa n3)))
                 (setq b(rtos (* a 2) 2 j0))
                 (setq x(rtos (car p6) 2 j0))
                 (setq y(rtos (cadr p6) 2 j0))
                 (setq d(- d 8))
                 (setq l1(list(-(car u)10)(-(+(cadr u)d)4)))
                 (setq l2(list(+(car u)10)(-(+(cadr u)d)4)))
                 (setq l3(list(+(car u)40)(-(+(cadr u)d)4)))
                 (setq l4(list(+(car u)70)(-(+(cadr u)d)4)))
                 (setq l5(list(+(car u)90)(-(+(cadr u)d)4)))
                 (setq l6(list(-(car u)10)(+(+(cadr u)d)4)))
                 (setq l7(list(+(car u)10)(+(+(cadr u)d)4)))
                 (setq l8(list(+(car u)40)(+(+(cadr u)d)4)))
                 (setq l9(list(+(car u)70)(+(+(cadr u)d)4)))
                 (setq l10(list(+(car u)90)(+(+(cadr u)d)4)))
                 (setq u1(list(car u)(+(cadr u)d)))
                 (setq u2(list(+(car u)25)(+(cadr u)d)))
                 (setq u3(list(+(car u)55)(+(cadr u)d)))
                 (setq u4(list(+(car u)80)(+(cadr u)d)))
                 (command "text" "m" p6 j1 "0" n4 "")
                 (command "text" "m" u1 j1 "0" n4 "")
                 (command "text" "m" u4 j1 "0" b "")
                 (command "text" "m" u2 j1 "0" x "")
                 (command "text" "m" u3 j1 "0" y "")
                 (command "line" l1 l6 "")
                 (command "line" l2 l7 "")
                 (command "line" l3 l8 "")
                 (command "line" l4 l9 "")
                 (command "line" l5 l10 "")
                 (command "line" l1 l5 "")
                 (command "line" l6 l10 "")
               ))  
           (if (> tt 1)
           (progn
           (setq m 0
                p6 nil
                p1 nil
                 s 0)
           (repeat tt
                 (setq t5 nil
                       t10 0)
                 (while (and(<= t10 tt)(= t5 nil))
                        (setq p1 (nth t10 p2))
                        (if (/= p1 nil)
                            (setq t5 t10))
                        (setq t10 (+ 1 t10))
                 )
                 (setq m 0)
                 (repeat i
                       (setq p3 (nth m p2))
                       (if (and (/= p3 nil)(/= p1 p3))
                           (progn
                              (setq t1 (angle p1 p3))
                              (if (and(<= t1 pi)(> t1 0))
                              (setq p1 p3))
                           )
                       )
                       (setq m(+ m 1))
                 )
                 (setq p2(subst nil p1 p2))
                 (setq p6 (trans p1 0 1))
                 (setq n3(+ n3 1))
                 (setq n4(strcat j2 (itoa n3)))
                 (setq b(rtos (* a 2) 2 j0))
                 (setq x(rtos (car p6) 2 j0))
                 (setq y(rtos (cadr p6) 2 j0))
                 (setq d(- d 8))
                 (setq l1(list(-(car u)10)(-(+(cadr u)d)4)))
                 (setq l2(list(+(car u)10)(-(+(cadr u)d)4)))
                 (setq l3(list(+(car u)40)(-(+(cadr u)d)4)))
                 (setq l4(list(+(car u)70)(-(+(cadr u)d)4)))
                 (setq l5(list(+(car u)90)(-(+(cadr u)d)4)))
                 (setq l6(list(-(car u)10)(+(+(cadr u)d)4)))
                 (setq l7(list(+(car u)10)(+(+(cadr u)d)4)))
                 (setq l8(list(+(car u)40)(+(+(cadr u)d)4)))
                 (setq l9(list(+(car u)70)(+(+(cadr u)d)4)))
                 (setq l10(list(+(car u)90)(+(+(cadr u)d)4)))
                 (setq u1(list(car u)(+(cadr u)d)))
                 (setq u2(list(+(car u)25)(+(cadr u)d)))
                 (setq u3(list(+(car u)55)(+(cadr u)d)))
                 (setq u4(list(+(car u)80)(+(cadr u)d)))
                 (setq s(+ s 1))
                 (if (= s tt)
                   (progn
                      (setq ss1(* tt 4))
                      ;(setq ss2(- d ss1))
                                       )
                 )
                 (command "text" "m" p6 j1 "0" n4 "")
                 (command "text" "m" u1 j1 "0" n4 "")
                 ;(command "text" "m" u4 j1 "" b "")
                 (command "text" "m" u2 j1 "0" x "")
                 (command "text" "m" u3 j1 "0" y "")
                 (command "line" l1 l6 "")
                 (command "line" l2 l7 "")
                 (command "line" l3 l8 "")
                 (command "line" l4 l9 "")
                 (command "line" l5 l10 "")
                 (command "line" l1 l4 "")
                 (if (= s tt)
                     (command "line" l1 l5 ""))
             ))
            )
            (setq n(+ n 1))
    )
    (setq t1(list(-(car u)10)(-(cadr u)4)))
    (setq t2(list(+(car t1)20)(cadr t1)))
    (setq t3(list(+(car t1)50)(cadr t1)))
    (setq t4(list(+(car t1)80)(cadr t1)))
    (setq t5(list(+(car t1)100)(cadr t1)))
    (setq t6(list(car t1)(+(cadr t1)8)))
    (setq t7(list(+(car t6)20)(cadr t6)))
    (setq t8(list(+(car t6)50)(cadr t6)))
    (setq t9(list(+(car t6)80)(cadr t6)))
    (setq t10(list(+(car t6)100)(cadr t6)))
    (command "line" t1 t6 "")
    (command "line" t2 t7 "")
    (command "line" t3 t8 "")
    (command "line" t4 t9 "")
    (command "line" t5 t10 "")
    (command "line" t1 t5 "")
    (command "line" t6 t10 "")
    (setq pp1(list(+(car t6)10)(+(cadr t1)4)))
    (command "text" "m" pp1 j1 "" "NO." "")
    (setq pp2(list(+(car t6)35)(+(cadr t1)4)))
    (command "text" "m" pp2 j1 "" "X" "")
    (setq pp3(list(+(car t6)65)(+(cadr t1)4)))
    (command "text" "m" pp3 j1 "" "Y" "")
    (setq pp4(list(+(car t6)90)(+(cadr t1)4)))
    (command "text" "m" pp4 j1 "" "DIA" "")
    (setq pp5(list(-(car u)10)(+(cadr t1)20)))
    (setq pp6(list(+(car u)90)(+(cadr t1)15)))
    (setq pp7(list(-(car u)10)(+(cadr t1)13)))
    (setq pp8(list(+(car u)45)(+(cadr t1)13)))
    (command "line" pp7 pp8 "")
    (command "text" "TL" pp5 (* j1 1.5) "0" "E.P POSITION" "")
    ;(setq n5(strcat  "1"))  
    (setq n5(strcat "E1~" n4))
    (command "text" "TR" pp6 j1 "" n5 "")
    (setvar "osmode" x0)
)

[ 本帖最后由 corw 于 2006-8-25 15:24 编辑 ]

真的不错，受益非浅

稍微改了一下

感謝chenjian1 兄的幫忙
再請教一下,您的2.1穿線孔的程式會出現以下內容而無法執行
"錯誤: no function definition: SUB-CHK-LAYER1"

可以拜託chenjian1 兄提供此相關des.VLX的程式好嗎?

这是一个检测图层的子程序,可以注释掉

这里基本都有了

谢谢,我很欣赏.