[LISP程序]：一个求实体(直线,圆弧,园,椭圆)关键点的小程序

lsjjm

一个求实体(直线,圆弧,园,椭圆)关键点的小程序, 请大家试用!
(defun pt (ent / ss pp)     
  (if (= (dxf 0 ent) "LINE")
    (setq pt1 (dxf 10 ent) pt2 (dxf 11 ent))
    (progn
      (setq pc (dxf 10 ent) r (dxf 40 ent))
      (cond
        ((= (dxf 0 ent) "ARC")
          (setq pt1 (polar pc (dxf 50 ent) r)
                pt2 (polar pc (dxf 51 ent) r))
          (setq pp (polar pc pi r))
          (setq ss (ssget pp))
          (if (/= ss nil)(setq pt5 pp))
          (setq pp (polar pc 0 r))
          (setq ss (ssget pp))
          (if (/= ss nil)(setq pt6 pp))
            (setq pp (polar pc (* 1.5 pi) r))
          (setq ss (ssget pp))
          (if (/= ss nil)(setq pt3 pp))
          (setq pp (polar pc (/ pi 2) r))
          (setq ss (ssget pp))
          (if (/= ss nil)(setq pt4 pp))
        )
        ((= (dxf 0 ent) "CIRCLE")
          (setq pt1 (polar pc pi r)
                pt2 (polar pc 0 r)
                pt3 (polar pc (* 1.5 pi) r)
                pt4 (polar pc (/ pi 2) r)))
        ((= (dxf 0 ent) "ELLIPSE")
          (setq  px (dxf 11 ent)
                pt1 (polar pc pi (car px))
                pt2 (polar pc 0 (car px))
                pt3 (polar pc (* 1.5 pi)(* r (car px)))
                pt4 (polar pc (/ pi 2)(* r (car px)))))
      );c
    );P
  );i
  (if (or (< (car pt2)(car pt1))
          (and (equal (car pt1)(car pt2) 0.0001)
               (< (cadr pt2)(cadr pt1))))
    (setq pt0 pt1 pt1 pt2 pt2 pt0)
  );if
  (if (= (getvar "worlducs") 0)
    (progn
      (if pt1 (setq pt1 (trans pt1 0 1)))
      (if pt2 (setq pt2 (trans pt2 0 1)))
      (if pt3 (setq pt3 (trans pt3 0 1)))
      (if pt4 (setq pt4 (trans pt4 0 1)))
      (if pc (setq pc (trans pc 0 1)))
   ))
);defun
(defun dxf (code ename)(cdr (assoc code (entget ename))))

陌生人

用来干什么？怎么用？

xzg_hello

能不能弄个求椭圆焦点的东东

aeo

最初由 xzg_hello 发布
[B]能不能弄个求椭圆焦点的东东 [/B]

看看:
http://www.xdcad.net/forum/showt ... d=426947#post426947
能不能求?

lsjjm

3楼:
椭圆焦点 Try this code:
(defun c:test ()
  (setq ent (car (entsel "\nSelect Ellipse: ")))
  (setq pc (dxf 10 ent))
  (setq px (dxf 11 ent)
        px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)
         a  (distance pc px)
         b (* (dxf 40 ent) a)
         c (sqrt (- (* a a)(* b b))))
  (vl-cmdf "point" (polar pc (angle pc px) c)
           "point" (polar pc (angle px pc) c))
)