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

rubbin

Tobyliang,VLX来了,请从下面的地址下载.

http://220.164.118.242:65003/get_flie.php?fid=1189132546-3552

Andyhon

rubbin发表于2007-9-7 10:22:00为何同样规格的圆却被分开了呢

Command: (equal rr13 rr15 1e-14)
T

Command: (equal rr13 rr15 1e-15)
nil

图面资料本如是 (有小尺寸的不同)

tobyliang

我已经修改好字体了，现在可以使用了，谢谢！但我的显示的怎么是问号啊

打开eplist.LSP文件有很多是汉字是乱码，请告知怎么解决好吗，

另外我想把编号移动到圆中心，知道怎么移动吗，请告诉我，谢谢你们了

tobyliang

rubbin你的给的下载地址不能打开啊，能不能上传上来

dkj0322

谢谢楼上的分享，参考下，很感激

quarx

谢谢分享，学习一下怎样用的

cyfdean

谢谢分享，学习一下怎样用的

cyfdean

我加了一段Gu_xl 大的代码（修正：法向Z坐标为-1时，不准问题），个人感觉很完美了
(defun c:Eplist  (/ ss za mat n)
  (setq j1 3.5)
  (setq p0 (getpoint "\n指定原点:"))
  (command "ucs" "o" p0)
  (setq u (getpoint "\n表格位置:"))
  (setq j0 (getint "\n小数位<2>:"))
  (if (= j0 nil)
    (setq j0 2)
  )
  (setq jj1 (getint "\n字体大小<3.5>:"))
  (if (= jj1 nil)
    (setq jj1 3.5)
  )
  (setq j2 (getstring "\n名称前缀:"))
  (if (= j2 nil)
    (setq j2 "E")
  )
  (setq l 0)
  (vl-Load-com)
  (setq t0 (ssget))
  (if t0
    (repeat (setq n (sslength t0))
      (setq obj (vlax-ename->vla-object (ssname t0 (setq n (1- n)))))
      (setq ZA (vlax-safearray->list
                 (vlax-variant-value (vla-get-Normal obj))))
      (setq mat        (vlax-tmatrix
                  (list
                    (list 1 0 (car ZA) 0)
                    (list 0 1 (cadr ZA) 0)
                    (list 0 0 (caddr ZA) 0)
                    (list 0 0 0 1)
                    )
                  )
            )
      (vla-TransformBy obj mat)
      )ap
    )
  (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" "m" p6 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" "m" p6 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 "" "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 "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)
  (setvar "CmdEcho" 1)
  (prin1)
)
;|
  ===>
  (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)
|;
(princ "\n加载顶针坐标列表:Eplist \n")
(princ)