带对话框的圆坐标列表程序

sirius

谢谢以上各位~ 最近正在学

mico_ye

可否将epcen的源等程序发出学习一下呀，谢谢

gqh362427

有点曙

jek.wang

不知道怎么用!

wuxuloveguo

都是高手啊!太强了!都不错!

starlet2003

不知道程序的目的是什么？

wuxuloveguo

哈哈!都是高手啊!厉害!

starlet2003

源程序在哪里呀？

dkj0322

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

cyfdean

用这个吧：



(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)