[分享]顶针（圆）列表程序

tobyliang

这是个非常好顶针列表程序，但调用时会出错，谁能帮忙找出原因，修改一下啊

(defun c:eplist()
(setq j1 0)
(setq jj1 5)
(setq TEXT (getvar "TEXTSTYLE"))
(COMMAND "_STYLE" "EPLIST" "ISOCP.SHX,CTXT.SHX" "0" "1" "0" "N" "N")
(setvar "TEXTSTYLE" "EPLIST")
(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请确定字高<2.5>:"))
(if ( = j1 nil)
(setq j1 2.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)))
          (setq p10(list (+(car p6)(/ a 0.9)) (cadr p6)))
          (command "text" "bl" p10 j1 "0" n4 "")
          (command "text" "m" u1 jj1 "0" n4 "")
          (command "text" "m" u4 jj1 "0" b "")
          (command "text" "m" u2 jj1 "0" x "")
          (command "text" "m" u3 jj1 "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))
            (setq u5(list(+(car u)80)(-(+(+(cadr u)d)ss1)4)))
            (command "text" "m" u5 jj1 "0" b "")
          )
          )
          (setq p10(list (+(car p6)(/ a 0.9)) (cadr p6)))
          (command "text" "bl" p10 j1 "0" n4 "")
          (command "text" "m" u1 jj1 "0" n4 "")
          ;(command "text" "m" u4 jj1 "" b "")
          (command "text" "m" u2 jj1 "0" x "")
          (command "text" "m" u3 jj1 "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 jj1 "" "NO." "")
  (setq pp2(list(+(car t6)35)(+(cadr t1)4)))
  (command "text" "m" pp2 jj1 "" "X值" "")
  (setq pp3(list(+(car t6)65)(+(cadr t1)4)))
  (command "text" "m" pp3 jj1 "" "Y值" "")
  (setq pp4(list(+(car t6)90)(+(cadr t1)4)))
  (command "text" "m" pp4 jj1 "" "直径" "")
  (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 "text" "TL" pp5 (* jj1 1.5) "0" "%%UE.P POSITION" "")
  ;(setq n5(strcat "1"))
  (setq n5(strcat "E1~" n4))
  (command "text" "TR" pp6 jj1 "" n5 "")
  (setvar "osmode" x0)
)

Andyhon

  ===>
  (command "text" "TL" pp5 (* jj1 1.5) 0 "%%UE.P POSITION")
  ;(setq n5(strcat "1"))
  (setq n5(strcat "E1~" n4))
  (command "text" "TR" pp6 jj1 0 n5)
  (setvar "osmode" x0)
  (prin1)

tobyliang

Andyhon你好！谢谢你的回复，我修改了，好像还不行啊，能不能将编译好的程序传上来让我试试，学习一下啊

Andyhon

測我的圖面可以底 

请另行提供测试用图面及使用版本

rubbin

http://220.164.118.242:65003/get_flie.php?fid=1189129330-3903

请Andy兄用上面的图档试试,会出错,烦请解决.

因论坛出错,上传不了图档.

tobyliang

用Andyhon兄的图档和命令可以运行，效果和图一样，但新建一个图档或其他图档就不能用了，出错如下面所示：不知如何解决。

rubbin兄，能不能将你上次写的顶针列表程序发上来共享一下啊

命令: ; 错误: AutoCAD 变量设置被拒绝: "TEXTSTYLE" "EPLIST"
命令: eplist _STYLE 输入文字样式名或 [?] <C_TEXTSTYLE>: EPLIST
新样式。
指定完整的字体名或字体文件名 (TTF 或 SHX): <txt>: ISOCP.SHX,CTXT.SHX CTXT.SHX 是常规字体，不是大字体。
命令: 0 未知命令“0”。按 F1 查看帮助。
命令: 1 未知命令“1”。按 F1 查看帮助。
命令: 0 未知命令“0”。按 F1 查看帮助。
命令: N 未知命令“N”。按 F1 查看帮助。
命令: N 未知命令“N”。按 F1 查看帮助。
命令: ; 错误: AutoCAD 变量设置被拒绝: "TEXTSTYLE" "EPLIST"

Andyhon

 小做修订...
 

rubbin

Andy兄,为何同样规格的圆却被分开了呢.13,14,15项的圆.不知何解.

Tobyliang先前的顶针列表是有的,但是我没有源码,我那个程序也是请别人帮忙修改的.只有VLX文件,不过也是存在楼上同样的问题.

rubbin

Tobyliang你的程序出错,是因为你没有"Ctxt.shx"这种大字体,或者你在程序中改用其它的大字体就可以解决了.

tobyliang

rubbin兄：VLX文件也可以啊，能不能共享一下，谢谢！