求圆弧中点坐标程序能否简化？

风之助

拟在程序中标注选择范围内所有圆弧，有以下程序，请高手指正！

2. (vl-load-com)
3. (setq ss (ssget '((0 . "ARC"))))
4. (setq i -1)
5. (setq osmodeOld (getvar "OSMODE"))
6. (setvar "OSMODE" 0)
7. (while (setq ent (ssname ss (setq i (1+ i))))
8.     (setq obj (vlax-ename->vla-object ent))
9.     ;;求圆弧中点坐标
10.     (setq ptMid (vlax-curve-getpointatdist
11.       obj
12.       (/ (vlax-curve-getdistatparam
13.       obj
14.       (vlax-curve-getendparam obj)
15.          )
16.          2
17.       )
18.   )
19.     )
20.     ;;求圆弧中心坐标
21.     (setq ptCen (cdr (assoc 10 (entget ent))))
22.     ;;求圆弧中点与圆弧中心连结上靠近圆弧中点一点坐标
23.     (setq ptMid0
24.       (list
25.    (+ (car ptMid) (* 0.001 (- (car ptCen) (car ptMid))))
26.    (+ (cadr ptMid)
27.       (* 0.001 (- (cadr ptCen) (cadr ptMid)))
28.    )
29.       )
30.     )
31.     (command "_.dimradius" (list ent ptMid) ptMid0)
32. )
33. (setvar "OSMODE" osmodeOld)
34. (setq ss nil)
35. (princ)

(vl-load-com) (setq ss (ssget '((0 . "ARC")))) (setq i -1) (setq osmodeOld (getvar "OSMODE")) (setvar "OSMODE" 0) (while (setq ent (ssname ss (setq i (1+ i))))     (setq obj (vlax-ename->vla-object ent))     ;;求圆弧中点坐标     (setq ptMid (vlax-curve-getpointatdist       obj       (/ (vlax-curve-getdistatparam       obj       (vlax-curve-getendparam obj)          )          2       )   )     )     ;;求圆弧中心坐标     (setq ptCen (cdr (assoc 10 (entget ent))))     ;;求圆弧中点与圆弧中心连结上靠近圆弧中点一点坐标     (setq ptMid0       (list    (+ (car ptMid) (* 0.001 (- (car ptCen) (car ptMid))))    (+ (cadr ptMid)       (* 0.001 (- (cadr ptCen) (cadr ptMid)))    )       )     )     (command "_.dimradius" (list ent ptMid) ptMid0) ) (setvar "OSMODE" osmodeOld) (setq ss nil) (princ)

xyp1964

2. (defun c:test ()
3.   (defun dxf (code elist) (cdr (assoc code elist)))
4.   (setq ss (ssget '((0 . "ARC")))
5. i  -1
6.   )
7.   (setvar "OSMODE" 0)
8.   (while (setq s1 (ssname ss (setq i (1+ i))))
9.     (setq ent (entget s1)
10.    pt0 (dxf 10 ent)
11.    pt  (polar pt0
12.        (/ (+ (dxf 50 ent) (dxf 51 ent)) 2.0)
13.        (dxf 40 ent)
14.        )
15.     )
16.     (command "_.dimradius" (list s1 pt) pt0)
17.   )
18.   (princ)
19. )

(defun c:test ()   (defun dxf (code elist) (cdr (assoc code elist)))   (setq ss (ssget '((0 . "ARC"))) i  -1   )   (setvar "OSMODE" 0)   (while (setq s1 (ssname ss (setq i (1+ i))))     (setq ent (entget s1)    pt0 (dxf 10 ent)    pt  (polar pt0        (/ (+ (dxf 50 ent) (dxf 51 ent)) 2.0)        (dxf 40 ent)        )     )     (command "_.dimradius" (list s1 pt) pt0)   )   (princ) )

无痕

凭直觉，

(/ (+ (dxf 50 ent) (dxf 51 ent)) 2.0) 是有问题的。

没有区分正反弧。例如，arc 起点角0,终点PI；另外一个 arc 起点PI，终点2pi（0）

.。。。。

ljpnb

3. (defun c:test ()
4.   (vl-load-com)
5.   (setq ss nil)
6.   (setq ss (ssget '((0 . "ARC"))))
7.   (setq i -1)
8.   (setq osmodeOld (getvar "OSMODE"))
9.   (setvar "OSMODE" 0)
10.   (while (setq ent (ssname ss (setq i (1+ i))))
11.     (setq dxf (entget ent))
12.     (setq r    (cdr (assoc 40 dxf))
13.    cen  (cdr (assoc 10 dxf))
14.    ang1 (cdr (assoc 50 dxf))
15.    ang2 (cdr (assoc 51 dxf))
16.     )
17.     (if (= ang2 0)
18.       (setq ang2 (* pi 2.0))
19.     )
20.     (setq ptmid  (polar cen (/ (+ ang1 ang2) 2.0) r)
21.    ptmid0 (polar cen (/ (+ ang1 ang2) 2.0) (* r 0.99))
22.     )
23.     (command "_.dimradius" (list ent ptMid) ptMid0)
24.   )
25.   (setvar "OSMODE" osmodeOld)
26.   (princ)
27. )

(defun c:test ()   (vl-load-com)   (setq ss nil)   (setq ss (ssget '((0 . "ARC"))))   (setq i -1)   (setq osmodeOld (getvar "OSMODE"))   (setvar "OSMODE" 0)   (while (setq ent (ssname ss (setq i (1+ i))))     (setq dxf (entget ent))     (setq r    (cdr (assoc 40 dxf))    cen  (cdr (assoc 10 dxf))    ang1 (cdr (assoc 50 dxf))    ang2 (cdr (assoc 51 dxf))     )     (if (= ang2 0)       (setq ang2 (* pi 2.0))     )     (setq ptmid  (polar cen (/ (+ ang1 ang2) 2.0) r)    ptmid0 (polar cen (/ (+ ang1 ang2) 2.0) (* r 0.99))     )     (command "_.dimradius" (list ent ptMid) ptMid0)   )   (setvar "OSMODE" osmodeOld)   (princ) )

Andyhon

From:  Doug Broad - view profile
Date:  Tues, Feb 11 2003 4:56 am 
Email:   "Doug Broad" <dbr...@earthlink.net>

Luis,
For 2D work with UCS = world this would be OK.
If you have arcs in 3D or a current UCS <> World then
you will have to do a lot more work.  Also, in order to
apply it within commands, you should either turn off
osnaps or ...

(defun midarc (ent / dxf ent info cen sa ea da ma)
  (defun dxf (k l)(cdr(assoc k l)))
  (and
    ent
    (setq info (entget ent))
    (= "ARC" (dxf 0 info))
    (setq cen (dxf 10 info));center
    (setq sa  (dxf 50 info));start
    (setq ea  (dxf 51 info));end
    (setq da  (- ea sa))
    (setq da (if (minusp da) (+ (* 2 pi) da) da))
    (setq ma (+ sa (/ da 2))))
  (if ma
    (polar cen ma (dxf 40 info))))

 

xyp1964

测试没问题！

ljpnb

xyp1964发表于2006-4-7 22:04:00 测试没问题！

我拿你的程序测试，问题很大呢，是我的标注设置有问题？？？？？？

xyp1964

2. (load "xyp_lib.vlx") ;版本 V.20060314
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
5. ★1·在acad.lsp中增加(load"xyp_lib")
6. ■2·在每个程序内增加(load"xyp_lib")
7. ■3·在command下，输入(load"xyp_lib")
8. ■4·在菜单.mnl中增加(load"xyp_lib")
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
11. [url]dispbbs.asp?boardID=3&ID=37554&page=1[/url]
12. |;
13. (defun c:test ()
14.   (cmdla0)
15.   (setvar "OSMODE" 0)
16.   (setq ss (ssget '((0 . "ARC"))) i  -1)
17.   (while (setq s1 (ssname ss (setq i (1+ i))))
18.     (setq pm  (xyp-get-CurveMidPoint s1)
19.     pmm (xyp-get-Midpoint pm (xyp-get-dxf 10 s1)))
20.     (command "_.dimradius" (list s1 pm) pmm))
21.   (cmdla1))

(load "xyp_lib.vlx") ;版本 V.20060314 ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下) 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： ★1·在acad.lsp中增加(load"xyp_lib") ■2·在每个程序内增加(load"xyp_lib") ■3·在command下，输入(load"xyp_lib") ■4·在菜单.mnl中增加(load"xyp_lib") ■5·将xyp_lib.vlx文件直接拽到cad屏幕 [COLOR=red] ★通用函数下载地址：[/COLOR] [url]dispbbs.asp?boardID=3&ID=37554&page=1[/url] |; (defun c:test ()   (cmdla0)   (setvar "OSMODE" 0)   (setq ss (ssget '((0 . "ARC"))) i  -1)   (while (setq s1 (ssname ss (setq i (1+ i))))     (setq pm  (xyp-get-CurveMidPoint s1)     pmm (xyp-get-Midpoint pm (xyp-get-dxf 10 s1)))     (command "_.dimradius" (list s1 pm) pmm))   (cmdla1))

yjtdkj

1. (defun tt ()
   
2. ;;;求两点间的中点
   
3.   (defun mid (p1 p2)
   
4.     (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
   
5.   )
   
6.   (setq en (car (entsel)))
   
7.   (setq pt1 (vlax-curve-getStartPoint en))
   
8.   (setq pt2 (vlax-curve-getEndPoint en))
   
9.   (setq mid_pt (mid pt1 pt2))                ;两点的中点
   
10.   (setq mid_pt (vlax-curve-getClosestPointTo en mid_pt)) ;圆弧中点
    
11. )

(defun tt ()<br /> ;;;求两点间的中点<br />   (defun mid (p1 p2)<br />     (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)<br />   )<br />   (setq en (car (entsel)))<br />   (setq pt1 (vlax-curve-getStartPoint en))<br />   (setq pt2 (vlax-curve-getEndPoint en))<br />   (setq mid_pt (mid pt1 pt2))                ;两点的中点<br />   (setq mid_pt (vlax-curve-getClosestPointTo en mid_pt)) ;圆弧中点<br /> )