有哪位大侠能看看这个标注合并的代码错在哪里？

a4587332 · 发表于 2013-12-27 20:52:27

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:dv(/ mkal hbdma mm mma mx ss e e70 c1 c2 q1 q2 q3 q4 q5 p0 a0 a1 a2 d d1 d2 r1 r2 r3 l l_ ll lfd ldm1 ldm2 ldm3 le tf tfzf tfhb tf2)
(defun mkal(tf23 q1 q3 q4 q5 q6 / x)(setq c1(if tfzf 14 10)c2(if tfzf 13 15))(if(not tf23)(progn(if(<(distance p0 q3)(distance p0 q5))(setq x q3 q3 q5 q5 x c1(if tfzf 14 15)c2(if tfzf 13 10)))(if(<(distance p0 q4)(distance p0 q6))(setq x q4 q4 q6 q6 x c1(if tfzf 13 10)c2(if tfzf 14 15)))))(setq a0(angle p0 q1)a1(angle p0 q3)a2(angle p0 q4)r1(distance p0 q1)r2(distance p0(cutz(_midp_ 11))))(if(> a1 a2)(setq a2(+ a2 _2pi)))(if(> a1 a0)(setq a0(+ a0 _2pi)))(setq tfzf(> a2 a0 a1)a2(if(> a2 _2pi)(- a2 _2pi)a2))(if(not tfzf)(setq a0 a1 a1 a2 a2 a0))(setq l_(list p0 r1)ll(assoc1 l_ ldm2 mm)q3(if tfzf q3 q4)q5(if tfzf q5 q6)l(if(> a1 a2)(list(list a1 _2pi tfzf tf23 q3 q5 r2 e)(list 0 a2))(list(list a1 a2 tfzf tf23 q3 q5 r2 e)))ldm2(if ll(subst(append ll l)ll ldm2)(cons(cons l_ l)ldm2))))(defun hbdma(/ e rt r1 r2 a a1 p1 p2 q x tfzf tf23)(if le(progn(foreach e le(entdel e))(mapcar'set'(a1 x tfzf tf23 p1 p2 rt e)l)(_calsun2_ e)(setq a(- a2 a1)a(/(if(< a 0)(+ a _2pi)a)2)q(polar p0(+ a1 a)rt)r1(distance p0 p1)p1(polar p0 a2 r1))(if tf23(_keyon_ 11 q(if tfzf 13 14)p1)(progn(setq r2(distance p0 q2)p2(polar p0 a2 r2))(_keyon_ 11 q c1 p1 c2 p2))))))(princ"\n请选取要合并的尺寸标注 <退出>: ")(if(setq ss(ssget'((0 . "DIMENSION"))))(progn(setq mm(* 0.005(getvar"viewsize"))mma 1e-3 mx 1e5)(_drags_)(_zoomw_)(_drag_ ss 0)(while(setq e(_slb_slb_ 0))(dm_tl3)(cond((dm_tl4 tf)(dm_tl5 tf)(dm_tl6)(setq a1(mergang a1)ll(assoc1 a1 ldm1 mma)l(list q1 q2 q3 q4 e)ldm1(if ll(subst(append ll(list l))ll ldm1)(cons(list a1 l)ldm1))))((member tf'(37 165 5 133))(setq p0(cutz(_midp_ 15)))(mkal T q1 q3 q4 nil nil))((member tf'(34 162 2 130))(setq q2(cutz(_midp_ 15))q5(cutz(_midp_ 16))p0(inters q1 q2 q3 q4 nil))(mkal nil q5 q1 q3 q2 q4))))(foreach ll ldm1(setq a1(car ll)a2(+ a1 _pi2)l(cadr ll)q1(car l)q2(polar q1 a1 mx)q3(polar q1 a2 mx)lfd nil)(foreach l(cdr ll)(setq d(_fren_(car l)q1 q2)d1(_fren_(car l)q1 q3)d2(_fren_(cadr l)q1 q3)tfzf(< d1 d2)l(cons(if tfzf d1 d2)(cons(if tfzf d2 d1)(cons tfzf l)))l_(assoc1 d lfd mm)lfd(if l_(subst(append l_(list l))l_ lfd)(cons(list d l)lfd))))(foreach ll lfd(setq ll(apply'_modent_(cdr ll))tf2(= 2(length ll)))(while(setq l(car ll))(setq d(cadr l)tfhb nil)(while(and(setq ll(cdr ll)l_(car ll))(or(> d(-(car l_)mm))tf2))(setq d(cadr l_)tfhb T)(entdel(last l_)))(if tfhb(progn(_calsun2_(last l))(setq e70(_midp_ 70)d(- d(car l)))(apply'_keyon_(if(caddr l)(list 13(polar(nth 5 l)a1 d))(list 14(polar(nth 6 l)a1 d))))(if(= 128(logand 128 e70))(command".dim1""hom"(last l)"")))))))(foreach ll ldm2(setq l(car ll)p0(car l)ll(apply'_modent_(cdr ll))tf2(= 2(length ll)))(while(setq l(car ll))(setq a2(cadr l)le nil)(while(and(setq ll(cdr ll)l_(car ll))(or(> a2(-(car l_)mma))tf2))(setq a2(cadr l_)e(last l_)le(if(='ENAME(type e))(cons e le)le)))(if(equal(car l)0 mma)(cond((not ll)(princ"\n360度尺寸无法合并！"))((equal(cadr(last ll))_2pi mma)(setq ll(reverse ll)l(car ll))(while(and(setq ll(cdr ll)l_(car ll))(>(cadr l_)(-(car l)mm)))(setq e(last l)le(if(='ENAME(type e))(cons e le)le)l l_))(setq ll(reverse ll))(hbdma))(T(hbdma)))(hbdma))))(_wtor_)(_socas_))))

newer · 发表于 2013-12-27 21:41:36

你这样贴代码谁看都头晕啊。

st788796 · 发表于 2013-12-27 21:56:24

楼主从哪抄来的？

a4587332 · 发表于 2013-12-27 22:17:38

newer 发表于 2013-12-27 21:41
你这样贴代码谁看都头晕啊。

哈哈是别人代码老实说~~~
现在只会搞点简单难的不会

a4587332 · 发表于 2013-12-27 22:18:52

st788796 发表于 2013-12-27 21:56
楼主从哪抄来的？

哈哈是抄来的
新手干学lisp不久
现在几乎很多代码都是找的别人的

st788796 · 发表于 2013-12-27 22:34:47

a4587332 发表于 2013-12-27 22:18
哈哈是抄来的
新手干学lisp不久
现在几乎很多代码都是找的别人的

抄哪的？怎么错知道吗？

a4587332 · 发表于 2013-12-27 22:40:09

st788796 发表于 2013-12-27 22:34
抄哪的？怎么错知道吗？

运行了的有个变量有错误

st788796 · 发表于 2013-12-28 06:53:57

a4587332 发表于 2013-12-27 22:40
运行了的有个变量有错误

岂止一个变量，里面多少自定义函数，这些函数也是ARX定义的，你到人家环境下就没问题了

viphappy · 发表于 2013-12-28 12:00:55

给整理了一下：
(defun c:dv (/ mkal hbdma mm mma mx ss e e70 c1 c2 q1 q2 q3 q4 q5 p0 a0 a1
         a2 d d1 d2 r1 r2 r3 l l_ ll lfd ldm1 ldm2 ldm3 le tf tfzf
         tfhb tf2
      )
  (defun mkal (tf23 q1 q3 q4 q5 q6 / x)
(setq c1 (if tfzf
         14
         10
      )
   c2 (if tfzf
         13
         15
      )
)
(if (not tf23)
   (progn
(if (< (distance p0 q3) (distance p0 q5))
   (setq x q3
q3 q5
q5 x
c1 (if tfzf
      14
      15
   )
c2 (if tfzf
      13
      10
   )
   )
)
(if (< (distance p0 q4) (distance p0 q6))
   (setq x q4
q4 q6
q6 x
c1 (if tfzf
      13
      10
   )
c2 (if tfzf
      14
      15
   )
   )
)
   )
)
(setq a0 (angle p0 q1)
   a1 (angle p0 q3)
   a2 (angle p0 q4)
   r1 (distance p0 q1)
   r2 (distance p0 (cutz (_midp_ 11)))
)
(if (> a1 a2)
   (setq a2 (+ a2 _2pi))
)
(if (> a1 a0)
   (setq a0 (+ a0 _2pi))
)
(setq tfzf (> a2 a0 a1)
   a2 (if (> a2 _2pi)
         (- a2 _2pi)
         a2
      )
)
(if (not tfzf)
   (setq a0 a1
      a1 a2
      a2 a0
   )
)
(setq l_ (list p0 r1)
   ll (assoc1 l_ ldm2 mm)
   q3 (if tfzf
         q3
         q4
      )
   q5 (if tfzf
         q5
         q6
      )
   l (if (> a1 a2)
      (list (list a1 _2pi tfzf tf23 q3 q5 r2 e) (list 0 a2))
      (list (list a1 a2 tfzf tf23 q3 q5 r2 e))
      )
   ldm2 (if ll
   (subst
   (append
      ll
      l
   )
   ll
   ldm2
   )
   (cons (cons l_ l) ldm2)
         )
)
  )
  (defun hbdma (/ e rt r1 r2 a a1 p1 p2 q x tfzf tf23)
(if le
   (progn
(foreach e le
   (entdel e)
)
(mapcar'set' (a1 x tfzf tf23 p1 p2 rt e) l)
(_calsun2_ e)
(setq a (- a2 a1)
      a (/ (if (< a 0)
      (+ a _2pi)
      a
   ) 2
)
      q (polar p0 (+ a1 a) rt)
      r1 (distance p0 p1)
      p1 (polar p0 a2 r1)
)
(if tf23
   (_keyon_ 11 q (if tfzf
   13
   14
) p1
   )
   (progn
      (setq r2 (distance p0 q2)
   p2 (polar p0 a2 r2)
      )
      (_keyon_ 11 q c1 p1 c2 p2)
   )
)
   )
)
  )
  (princ "\n请选取要合并的尺寸标注 <退出>: ")
  (if (setq ss (ssget' ((0 . "DIMENSION"))))
(progn
   (setq mm (* 0.005 (getvar "viewsize"))
      mma 1e-3
      mx 1e5
   )
   (_drags_)
   (_zoomw_)
   (_drag_ ss 0)
   (while (setq e (_slb_slb_ 0))
(dm_tl3)
(cond
   ((dm_tl4 tf)
      (dm_tl5 tf)
      (dm_tl6)
      (setq a1 (mergang a1)
   ll (assoc1 a1 ldm1 mma)
   l (list q1 q2 q3 q4 e)
   ldm1 (if ll
   (subst
   (append
      ll
      (list l)
   )
   ll
   ldm1
   )
   (cons (list a1 l) ldm1)
         )
      )
   )
   ((member tf' (37 165 5 133))
      (setq p0 (cutz (_midp_ 15)))
      (mkal t q1 q3 q4 nil nil)
   )
   ((member tf' (34 162 2 130))
      (setq q2 (cutz (_midp_ 15))
   q5 (cutz (_midp_ 16))
   p0 (inters
         q1
         q2
         q3
         q4
         nil
      )
      )
      (mkal nil q5 q1 q3 q2 q4)
   )
)
   )
   (foreach ll ldm1
(setq a1 (car ll)
      a2 (+ a1 _pi2)
      l (cadr ll)
      q1 (car l)
      q2 (polar q1 a1 mx)
      q3 (polar q1 a2 mx)
      lfd nil
)
(foreach l (cdr ll)
   (setq d (_fren_ (car l) q1 q2)
d1 (_fren_ (car l) q1 q3)
d2 (_fren_ (cadr l) q1 q3)
tfzf (< d1 d2)
l (cons (if tfzf
   d1
   d2
) (cons (if tfzf
   d2
   d1
) (cons tfzf l)
   )
   )
l_ (assoc1 d lfd mm)
lfd (if l_
      (subst
(append
   l_
   (list l)
)
l_
lfd
      )
      (cons (list d l) lfd)
      )
   )
)
(foreach ll lfd
   (setq ll (apply'_modent_ (cdr ll))
tf2 (= 2 (length ll))
   )
   (while (setq l (car ll))
      (setq d (cadr l)
   tfhb nil
      )
      (while (and
      (setq ll (cdr ll)
   l_ (car ll)
      )
      (or
         (> d (- (car l_) mm))
         tf2
      )
   )
      (setq d (cadr l_)
      tfhb t
      )
      (entdel (last l_))
      )
      (if tfhb
      (progn
(_calsun2_ (last l))
(setq e70 (_midp_ 70)
      d (- d (car l))
)
(apply'_keyon_ (if (caddr l)
   (list 13 (polar (nth 5 l) a1 d))
   (list 14 (polar (nth 6 l) a1 d))
         )
)
(if (= 128 (logand 128 e70))
   (command ".dim1" "hom" (last l) "")
)
      )
      )
   )
)
   )
   (foreach ll ldm2
(setq l (car ll)
      p0 (car l)
      ll (apply'_modent_ (cdr ll))
      tf2 (= 2 (length ll))
)
(while (setq l (car ll))
   (setq a2 (cadr l)
le nil
   )
   (while (and
   (setq ll (cdr ll)
   l_ (car ll)
   )
   (or
      (> a2 (- (car l_) mma))
      tf2
   )
   )
      (setq a2 (cadr l_)
   e (last l_)
   le (if (='ename (type e))
         (cons e le)
         le
      )
      )
   )
   (if (equal (car l) 0 mma)
      (cond
      ((not ll)
(princ "\n360度尺寸无法合并！")
      )
      ((equal (cadr (last ll)) _2pi mma)
(setq ll (reverse ll)
      l (car ll)
)
(while (and
   (setq ll (cdr ll)
         l_ (car ll)
   )
   (> (cadr l_) (- (car l) mm))
         )
   (setq e (last l)
le (if (='ename (type e))
      (cons e le)
      le
   )
l l_
   )
)
(setq ll (reverse ll))
(hbdma)
      )
      (t
(hbdma)
      )
      )
      (hbdma)
   )
)
   )
   (_wtor_)
   (_socas_)
)
  )
)

小妖妖 · 发表于 2013-12-28 12:35:32

i want to 吐！

a4587332 · 发表于 2017-5-5 00:03:08

viphappy 发表于 2013-12-28 12:00

好久没上来了居然有人整理啊！受宠若惊太感谢了

Lisphk · 发表于 2017-5-5 00:06:26

楼主，你这个代码是天正TS里面的吧，要在天正TS环境下才能执行。

a4587332 · 发表于 2017-5-5 00:09:29

Lisphk 发表于 2017-5-5 00:06

感谢提供线索

狼墨 · 发表于 2019-1-28 01:02:01

a4587332 发表于 2017-5-5 00:09
感谢提供线索

快捷键  ddc  标注合并
(defun c:ddc( / d13 d14 dxf dxfn e1 e2 n p13 p14 plst ss)
  (command "ucs" "w")
  (setvar "cmdecho" 0)
  (princ "\n选择标注尺寸...")
  (setq ss (ssget '((0 . "DIMENSION"))))
  (setq n -1 plst '())
  (repeat (sslength ss)
   (setq dxf (entget (ssname ss (setq n (1+ n)))))
   (setq d13 (cdr (assoc 13 dxf))
         d14 (cdr (assoc 14 dxf)))
   (setq plst (cons d13 (cons d14 plst))))
  (setq plst (vl-sort plst (function (lambda (e1 e2) (< (car e1) (car e2))))))
  (setq plst (vl-sort plst (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
  (setq p13 (car plst) p14 (last plst))
  (setq dxfn (subst (cons 13 p13) (assoc 13 dxf) dxf)
      dxfn (subst (cons 14 p14) (assoc 14 dxfn) dxfn))
  (entmake dxfn)
  (command ".erase" ss "")
  (command "ucs" "p")
  (princ))

账号		自动登录	找回密码
密码			立即注册

[每日一码] 有哪位大侠能看看这个标注合并的代码错在哪里？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评