求大神指导，我想设置一个循环，可以选择多个圆弧，最后同时得到圆弧每个属性...
本帖最后由 Gu_xl 于 2014-1-14 07:46 编辑(defun c:wyb ()
(princ "\n功能：依次选取多个圆弧对象，最后在CAD内创建一个表格，将每个圆弧的属性参数放入表中。")
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(if (and
;;entsel函数返回值包含两个元素，第一个元素是用户所选对象的图元名，第二个元素是用户选择对象时指定的拾取点的坐标值
;;cadr函数返回表的第二个元素
;;entget获得对象（图元）的定义数据
;;member搜索表中是否包含某表达式，并从该表达式的第一次出现处返回表的其余部分
(setq en (entsel "\n请选择圆弧对象: "))
(setq pt (cadr en));获取拾取点坐标
(setq ent (entget (car en))) ;获取图元的定义数据
(member '(0 . "ARC") ent) ;;判断选取的实体是不是圆弧
;;(princ "\nok")
(setq PT (vlax-curve-getclosestpointto (vlax-ename->vla-object (car en)) PT));;将 AutoLISP 类型的对象名转换为 VLA 对象，并返回圆弧上离指定点最近的点（在 WCS 上）
)
(progn
(setq pt1 (getpoint pt "\n请点取圆弧属性参数表格放置位置"))
(setq w1 (getdist "\n 第一列宽度<30>: "))
(if (null w1) (setq w1 30.0))
(setq w2 (getdist "\n 第二列宽度<17>: "))
(if (null w2) (setq w2 17.0))
(setq w3 (getdist "\n 第三列宽度<17>: "))
(if (null w3) (setq w3 17.0))
(setq w4 (getdist "\n 第四列宽度<17>: "))
(if (null w4) (setq w4 17.0))
(setq hh (getdist "\n 每行高度<7>: "))
(if (null hh) (setq hh 7.0))
(setq pt2 (polar pt1 0 w1))
(setq pt3 (polar pt2 0 w2))
(setq pt4 (polar pt3 0 w3))
(setq pt5 (polar pt4 0 w4))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt10 (polar pt1 (* pi 1.5) hh))
(command "pline" pt1 pt5 pt6 pt10 "c")
;;pline命令，画线是按照点的顺序依次相连的
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 "偏角")
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 "R（米）")
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 "T（米）")
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 "L（米）")
;;==================
;;获取圆弧属性参数
;;转角、半径、切线长、弧长等
(setq ang (- (cdr (assoc 51 ent)) (cdr (assoc 50 ent))))
(if (< ang 0)
(setq ang (+ pi pi ang))
)
;;半径
(setq r (cdr (assoc 40 ent)))
;;切线长
(setq ttt (* (/ (sin (* 0.5 ang)) (cos (* 0.5 ang))) r))
;;长度
(setq lll (* r ang))
(setq pt1 pt10 pt2 pt9 pt3 pt8 pt4 pt7 pt5 pt6)
(setq pt10 (polar pt1 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "pline" pt5 pt6 pt10 pt1 "c")
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 (angtos ang 1 5))
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 (rtos r 2 3))
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 (rtos ttt 2 3))
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 (rtos lll 2 3))
(setq pt1 pt10 pt2 pt9 pt3 pt8 pt4 pt7 pt5 pt6)
(setq pt10 (polar pt1 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "pline" pt5 pt6 pt10 pt1 "c")
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 (angtos ang 1 5))
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 (rtos r 2 3))
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 (rtos ttt 2 3))
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 (rtos lll 2 3))
))
(setvar "osmode" os)
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 鼻祖wq的微博 (defun c:wyb ( / a ang b en ent hh i l lll ospt1 pt10 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 r ss ttt w1 w2 w3 w4)
(princ "\n功能：依次选取多个圆弧对象，最后在CAD内创建一个表格，将每个圆弧的属性参数放入表中。")
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "ARC"))))
(if ss
(repeat (setq i (sslength ss))
(setq l (cons(ssname ss (setq i (1- i))) l))
)
)
(foreach en l
(if (and
;;entsel函数返回值包含两个元素，第一个元素是用户所选对象的图元名，第二个元素是用户选择对象时指定的拾取点的坐标值
;;cadr函数返回表的第二个元素
;;entget获得对象（图元）的定义数据
;;member搜索表中是否包含某表达式，并从该表达式的第一次出现处返回表的其余部分
en
(setq ent (entget en)) ;获取图元的定义数据
(member '(0 . "ARC") ent) ;;判断选取的实体是不是圆弧
)
(progn
(setq pt1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) (Vlax-Get (Vlax-Ename->Vla-Object en) 'EndPoint) (Vlax-Get (Vlax-Ename->Vla-Object en) 'StartPoint)))
(setq w1 30.0)
(setq w2 17.0)
(setq w3 17.0)
(setq w4 17.0)
(setq hh 7.0)
(setq pt2 (polar pt1 0 w1))
(setq pt3 (polar pt2 0 w2))
(setq pt4 (polar pt3 0 w3))
(setq pt5 (polar pt4 0 w4))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt10 (polar pt1 (* pi 1.5) hh))
(command "pline" pt1 pt5 pt6 pt10 "c")
;;pline命令，画线是按照点的顺序依次相连的
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 "偏角")
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 "R（米）")
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 "T（米）")
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 "L（米）")
;;==================
;;获取圆弧属性参数
;;转角、半径、切线长、弧长等
(setq ang (- (cdr (assoc 51 ent)) (cdr (assoc 50 ent))))
(if (< ang 0)
(setq ang (+ pi pi ang))
)
;;半径
(setq r (cdr (assoc 40 ent)))
;;切线长
(setq ttt (* (/ (sin (* 0.5 ang)) (cos (* 0.5 ang))) r))
;;长度
(setq lll (* r ang))
(setq pt1 pt10 pt2 pt9 pt3 pt8 pt4 pt7 pt5 pt6)
(setq pt10 (polar pt1 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "pline" pt5 pt6 pt10 pt1 "c")
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 (angtos ang 1 5))
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 (rtos r 2 3))
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 (rtos ttt 2 3))
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 (rtos lll 2 3))
(setq pt1 pt10 pt2 pt9 pt3 pt8 pt4 pt7 pt5 pt6)
(setq pt10 (polar pt1 (* pi 1.5) hh))
(setq pt9 (polar pt2 (* pi 1.5) hh))
(setq pt8 (polar pt3 (* pi 1.5) hh))
(setq pt7 (polar pt4 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "pline" pt5 pt6 pt10 pt1 "c")
(command "line" pt2 pt9 "")
(command "line" pt3 pt8 "")
(command "line" pt4 pt7 "")
(command "text" "m" (inters pt1 pt9 pt10 pt2) (/ hh 2) 0 (angtos ang 1 5))
(command "text" "m" (inters pt2 pt8 pt9 pt3) (/ hh 2) 0 (rtos r 2 3))
(command "text" "m" (inters pt3 pt7 pt8 pt4) (/ hh 2) 0 (rtos ttt 2 3))
(command "text" "m" (inters pt4 pt6 pt7 pt5) (/ hh 2) 0 (rtos lll 2 3))
)))
(setvar "osmode" os)
)
cable2004 发表于 2014-1-13 19:34 static/image/common/back.gif
(defun c:wyb ( / a ang b en ent hh i l lll ospt1 pt10 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 r ss ttt w1...
大神！首先非常感谢您了！竟然帮我改了，但是这个程序结果与我想要的还是有点偏差，我希望最后所有曲线的属性都写在一张表里面，共4列，第一行是表头，写着偏角、r、t、l；后面各行依次写着所选取的曲线的属性参数。不知道这个能不能实现，求大神指教！再次非常感谢！ (defun c:wyb ( / ang en ent hh lll os pb p1 p2 p3 p4 p5 p6 p7 p8 p9 r ss ttt w1 w)
(defun midp (pp1 pp2) (mapcar '(lambda (a b) (/ (+ a b) 2)) pp1 pp2))
(princ "\n功能：依次选取多个圆弧对象，最后在CAD内创建一个表格，将每个圆弧的属性参数放入表中。")
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (list))
(while (setq s1 (entsel "\n请选择圆弧对象: "))
(setq ss (cons (car s1) ss))
)
(setq pb (getpoint "\n表格起点: "))
(setq w1 30.0 w 17.0 hh 7.0)
(setq p1 (polar pb 0 w1))
(setq p2 (polar p1 0 w))
(setq p3 (polar p2 0 w))
(setq p4 (polar p3 0 w))
(setq p9 (polar pb (* pi 1.5) hh))
(setq p5 (polar p1 (* pi 1.5) hh))
(setq p6 (polar p2 (* pi 1.5) hh))
(setq p7 (polar p3 (* pi 1.5) hh))
(setq p8 (polar p4 (* pi 1.5) hh))
;画表头
(command "pline" pb p4 p8 p9 "c")
(command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")
(command "text" "m" (midp pb p5) (/ hh 2) 0 "偏角")
(command "text" "m" (midp p1 p6) (/ hh 2) 0 "R（米）")
(command "text" "m" (midp p2 p7) (/ hh 2) 0 "T（米）")
(command "text" "m" (midp p3 p8) (/ hh 2) 0 "L（米）")
(setq ss (reverse ss))
(foreach en ss
(if (and (setq ent (entget en)) ;获取图元的定义数据
(member '(0 . "ARC") ent) ;;判断选取的实体是不是圆弧
) (progn
;;==================
;;获取圆弧属性参数: 转角、半径、切线长、弧长等
(setq r (cdr(assoc 40 ent)) ;;半径
st (cdr(assoc 50 ent))
ed (cdr(assoc 51 ent)))
(setq ang (- ed st))
(if (< ang 0) (setq ang (+ pi pi ang)))
(setq ttt (* (/ (sin (* 0.5 ang)) (cos (* 0.5 ang))) r)) ;;切线长
(setq lll (* r ang)) ;;长度
(setq pb p9 p1 p5 p2 p6 p3 p7 p4 p8)
(setq p9 (polar pb (* pi 1.5) hh))
(setq p5 (polar p1 (* pi 1.5) hh))
(setq p6 (polar p2 (* pi 1.5) hh))
(setq p7 (polar p3 (* pi 1.5) hh))
(setq p8 (polar p4 (* pi 1.5) hh))
(command "pline" pb p4 p8 p9 "c")
(command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")
(command "text" "m" (midp pb p5) (/ hh 2) 0 (angtos ang 1 5))
(command "text" "m" (midp p1 p6) (/ hh 2) 0 (rtos r 2 3))
(command "text" "m" (midp p2 p7) (/ hh 2) 0 (rtos ttt 2 3))
(command "text" "m" (midp p3 p8) (/ hh 2) 0 (rtos lll 2 3))
))
)
(setvar "osmode" os)
)
ZZXXQQ 发表于 2014-1-14 09:02 static/image/common/back.gif
不错！非常感谢！ 这个很有用，谢谢分享
页:
[1]