[LISP程序]：多义线子段直线《》圆弧转换工具

lsjjm

多义线子段直线《》圆弧转换工具
(defun c:test ()
  (vl-load-com)
  (setq ent (entsel "\nSelect Polyline:"))
  (setq p (cadr ent)
      obj (vlax-ename->vla-object (car ent))
       pp (vlax-curve-getclosestpointto obj (trans p 1 0))
        n (fix (vlax-curve-getparamatpoint obj pp)))
  (initget "Value Radius")
  (setq k (getkword "\nEnter an option[Value/Radius]:"))          
  (cond
    ((= k "Value")
     (setq bu (getreal "\nNew Bulge Value:")))
    ((= k "Radius")
     (setq pl (vlax-safearray->list
               (vlax-variant-value
                 (vlax-get-property obj 'coordinates)))
          p1 (list (nth (* n 2) pl)(nth (1+ (* n 2)) pl))
          p2 (list (nth (* (1+ n) 2) pl)(nth (1+ (* (1+ n) 2)) pl))
         dis (distance p1 p2)
           r (getdist "\nInptu Radius:"))
     (if (< (abs r)(/ dis 2))
       (progn (alert "Radius is too small!")(exit))
     )
     (setq bu (tan (/ (asin (/ dis 2.0 r)) 2.0))))
  );
  (vlax-invoke-method obj 'SetBulge n bu)
);
(defun asin (r / result)
  (if (and (/= 1 (abs r))(/= 1.0 (abs r)))
    (setq result (atan (/ r (sqrt (- 1 (* r r))))))
    (cond
      ((< r 0) (setq result (/ pi -2.0)))
      ((> r 0) (setq result (/ pi 2.0)))
    );c
  );i
  result
);defun
(defun tan (x)(/ (sin x)(cos x)))

li809

反过来就见多,这个是第一次见,谢谢了

地鼠

用不了。有问题。

aneng

顶

yoyoho

实用程序
感谢楼主分享!