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

风之助 发表于 2006-4-6 22:27:00

拟在程序中标注选择范围内所有圆弧，有以下程序，请高手指正！(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 发表于 2006-4-6 23:55:00

(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)
)

无痕发表于 2006-4-7 04:05:00

凭直觉，
(<A href="http://www.mjtd.com/object/autolisp/47.htm" target="_blank" >/</A> (<A href="http://www.mjtd.com/object/autolisp/+.htm" target="_blank" >+</A> (dxf 50 ent) (dxf 51 ent)) 2.0) 是有问题的。
没有区分正反弧。例如，arc 起点角0,终点PI；另外一个 arc 起点PI，终点2pi（0）
.。。。。

ljpnb 发表于 2006-4-7 07:57:00

(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 发表于 2006-4-7 14:20:00

From:  Doug Broad - view profile Date:  Tues, Feb 11 2003 4:56 am  Email:   "Doug Broad" <<A href="mailto:dbr...@earthlink.net" target="_blank" >dbr...@earthlink.net</A>> 
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 发表于 2006-4-7 22:04:00

测试没问题！

ljpnb 发表于 2006-4-8 07:45:00

xyp1964发表于2006-4-7 22:04:00static/image/common/back.gif
测试没问题！

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

xyp1964 发表于 2006-4-8 16:29:00

本帖最后由作者于 2006-4-10 22:05:06 编辑

(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屏幕
★通用函数下载地址：
dispbbs.asp?boardID=3&ID=37554&page=1
|;
(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 发表于 2021-6-18 18:10:35

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

页: [1]

明经CAD社区's Archiver

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