求弧形最大的长和宽怎么完成

happy訫誶

求弧形最大的长和宽怎么完成


该贴已经同步到 happy訫誶的微博

Linhay

论坛找“最小包围盒”，会有惊喜

xiaolong1487

2. (defun MJ:GetssBox (ss / i l1 l2 ll ur)
   
3.   (repeat (setq i (sslength ss))
   
4.     (vla-getboundingbox
   
5.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
   
6.       'll
   
7.       'ur
   
8.     )
   
9.     (setq l1 (cons (vlax-safearray->list ll) l1)
   
10.           l2 (cons (vlax-safearray->list ur) l2)
    
11.     )
    
12.   )
    
13.   (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
    
14.           '(min max)
    
15.           (list l1 l2)
    
16.   )
    
17. )
    
18. 
    
19. (if (setq ss (ssget))
    
20.         (progn
    
21.                 (setq pts (MJ:GetssBox ss))
    
22.                 (command "RECTANG" "non" (car pts) "non" (cadr pts))
    
23.         )
    
24. )

(defun MJ:GetssBox (ss / i l1 l2 ll ur)<br />   (repeat (setq i (sslength ss))<br />     (vla-getboundingbox<br />       (vlax-ename->vla-object (ssname ss (setq i (1- i))))<br />       'll<br />       'ur<br />     )<br />     (setq l1 (cons (vlax-safearray->list ll) l1)<br />           l2 (cons (vlax-safearray->list ur) l2)<br />     )<br />   )<br />   (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))<br />           '(min max)<br />           (list l1 l2)<br />   )<br /> )<br /> <br /> (if (setq ss (ssget))<br />         (progn<br />                 (setq pts (MJ:GetssBox ss))<br />                 (command "RECTANG" "non" (car pts) "non" (cadr pts))<br />         )<br /> )

llsheng_73

1. (defun c:RecofArc(/ e f a b c d r)
   
2.   (if(and(setq e(entsel"选择弧"))
   
3.   (setq e(vlax-ename->vla-object(car e)))
   
4.   (=(vlax-get-property e'ObjectName)"AcDbArc"))
   
5.     (progn
   
6.       (if(<(setq r(vla-get-Radius e))
   
7.   (setq a(vlax-curve-getStartPoint e);起点
   
8.         b(vlax-curve-getendPoint e);止点
   
9.         c(vlax-curve-getpointatparam e(*(+(vlax-curve-getstartparam e)(vlax-curve-getendparam e))0.5));弧顶(弧线中点)
   
10.         e(angle a b)
    
11.         d(mapcar'*(mapcar'+ a b)'(0.5 0.5 0.5));玄的中点
    
12.         f(angle d c)
    
13.         c(distance d c)));弓高
    
14. (setq a(polar d e r)b(polar d(+ pi e)r)))
    
15.       (entmake(append'((0 . "LWPOLYLINE")(100 . "AcDbEntity")(100 . "AcDbPolyline")(90 . 4)(70 . 1))
    
16.        (mapcar'(lambda(x)(cons 10 x))(list a b(polar b f c)(polar a f c)))))))
    
17. )

(defun c:RecofArc(/ e f a b c d r)<br />   (if(and(setq e(entsel"选择弧"))<br />   (setq e(vlax-ename->vla-object(car e)))<br />   (=(vlax-get-property e'ObjectName)"AcDbArc"))<br />     (progn<br />       (if(<(setq r(vla-get-Radius e))<br />   (setq a(vlax-curve-getStartPoint e);起点<br />         b(vlax-curve-getendPoint e);止点<br />         c(vlax-curve-getpointatparam e(*(+(vlax-curve-getstartparam e)(vlax-curve-getendparam e))0.5));弧顶(弧线中点)<br />         e(angle a b)<br />         d(mapcar'*(mapcar'+ a b)'(0.5 0.5 0.5));玄的中点<br />         f(angle d c)<br />         c(distance d c)));弓高<br /> (setq a(polar d e r)b(polar d(+ pi e)r)))<br />       (entmake(append'((0 . "LWPOLYLINE")(100 . "AcDbEntity")(100 . "AcDbPolyline")(90 . 4)(70 . 1))<br />        (mapcar'(lambda(x)(cons 10 x))(list a b(polar b f c)(polar a f c)))))))<br /> )

对于圆弧，其外接最小矩形的宽为玄高，当玄高小半径时（劣弧），其宽为玄长，否则以直径为宽

xyp1964

2. [size=14px];; tt(选择集最小外框)[/size](defun c:tt ()
   
3.   (if (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
   
4.     (xyp-rectang (xyp-9pt ss 1) (xyp-9pt ss 9))
   
5.   )
   
6.   (princ)
   
7. [size=14px])[/size]

[size=14px];; tt(选择集最小外框)[/size](defun c:tt ()<br />   (if (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))<br />     (xyp-rectang (xyp-9pt ss 1) (xyp-9pt ss 9))<br />   )<br />   (princ)<br /> [size=14px])[/size]