[LISP]標C角，源程序

zfq831227

(DEFUN C:cb();赻雄梓蛁给褒
  (setvar "osmode" 2)
  (setq spt (getpoint "\n恁寁给褒腔笢萸:"))
  (SETQ x(car spt) y(cadr spt ))
  (setq xd (+ x 0.001) yd (+ y 0.001))
  (setq pd1(list xd yd))
  (setq xf (- x 0.001) yf (- y 0.001))
  (setq pd2(list xf yf))
  (setq ss (ssget "c" pd1 pd2))
  (setq ent (entget(ssname ss 0)))
  (setq u1 (cdr (assoc 8 ent)))
  (setq lst (assoc 10 ent))
  (setq ptl '())
  (while lst
    (setq px1 (cdr lst))
    (setq ent (subst '(1000 . 1) lst ent))
    (setq ptL (cons px1 ptL))
    (setq lst (assoc 10 ent))
    )
  (setq X3 10000)
  (setq XTY (list X3))
  (setq X4 10000)
  (setq XTZ (list X4))
  (setq i(length ptl))
  (setq j 0)
  (repeat i
    (SETQ S2(nth j ptl))
    (SETQ X1(CAR S2) Y1(CADR S2))
  (SETQ x(car spt) y(cadr spt ))
    (SETQ XJ(ABS(-  X  X1)))
    (SETQ YJ(ABS(-  Y  Y1)))
    (setq x4 (sqrt(+ (expt xj 2) (expt yj 2))))
    (setq XTZ(cons X4 XTZ))
      (setq j (+ j 1))
   ) 
  (SETQ M (LENGTH XTZ))
  (SETQ R 0)
  (setq W1 (nth 0 XTZ))
  (REPEAT M
    (setq W2 (nth  R  XTZ))
        (IF (> W1 W2) (SETQ W1 W2))
        (SETQ R (+ R 1))
      )
  (SETQ X4 (RTOS (* W1 2) 2 4))
  (SETQ X3 (* (SQRT(/(EXPT W1 2) 2)) 2))
 
  (setq dn 10000)
  (setq db1 (list dn))
  (setq n 0)
  (repeat  I
    (IF (/= N (- I 1))
      (PROGN
    (setq n1 (nth n ptl))
    (setq n2 (nth (+ n 1) ptl))
    (SETQ nX1(CAR n1) nY1(CADR n1))
    (SETQ nX2(CAR n2) nY2(CADR n2))
    (setq dn (RTOS
              (sqrt
             (+ (expt (- (ABS nx2) (ABS nx1)) 2) (expt (- (ABS ny2) (ABS ny1)) 2))) 2 4))
     )
    )
    (IF (= I (+ N 1))
      (PROGN
      (setq n1 (nth n ptl))
    (setq n2 (nth 0 ptl))
    (SETQ nX1(CAR n1) nY1(CADR n1))
    (SETQ nX2(CAR n2) nY2(CADR n2))
    (setq dn (RTOS
            (sqrt
         (+ (expt (- (ABS nx2) (ABS nx1)) 2) (expt (- (ABS ny2) (ABS ny1)) 2))) 2 4))
    )
    )
    (setq db1(cons dn db1))
    (setq n (+ n 1))
      )
  
  (SETQ HQ (LENGTH DB1))
  (setq h 0)
  (setq f 0)
  (repeat hq
    (setq kk (nth f db1))
    (if (= X4 KK)(setq h (+ 1 h)))
      (setq f(+ f 1))
    )
 
  (setq d2 (getpoint"\n怀梓蛁腔源砃:"))
 
  (SETQ X5 (DISTOF(RTOS X3 2 0)))
  (SETQ X6 (DISTOF(RTOS X3 2 2)))
  (IF (OR (= H 0) (= H 1))
    (PROGN
    (IF (/= X5 X6)(SETQ W (STRCAT "C"(RTOS x3 2 1))))
    (IF (= X5 X6)(SETQ W (STRCAT "C"(RTOS x3 2 0 ))))
  ))
  (IF (AND(/= H 0) (/= H 1))
    (PROGN
    (IF (/= X5 X6)(setq w (STRCAT (RTOS h 2 0)"-C"(RTOS x3 2 1))))
    (IF (= X5 X6)(setq w (STRCAT (RTOS h 2 0)"-C"(RTOS x3 2 0 ))))
  ))
    (if (AND (OR (= u1 "BB")(= U1 "CC")) (= X3 2)) (SETQ W "C2 TYP")) 
  (COMMAND "LEADER"spt D2""W"")
  (setvar "osmode" 39)

  )

zfq831227

有时候不行，怎么回事

l982414603

可以用,但是C角标注在放位置的时候没有引线出来，