求大神指导，我想设置一个循环，可以选择多个圆弧，最后同时得到圆弧每个属性...

鼻祖wq

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

   )









该贴已经同步到 鼻祖wq的微博

cable2004

(defun c:wyb ( / a ang b en ent hh i l lll os  pt1 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)

   )

鼻祖wq

cable2004 发表于 2014-1-13 19:34
(defun c:wyb ( / a ang b en ent hh i l lll os  pt1 pt10 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 r ss ttt w1  ...

大神！首先非常感谢您了！竟然帮我改了，但是这个程序结果与我想要的还是有点偏差，我希望最后所有曲线的属性都写在一张表里面，共4列，第一行是表头，写着偏角、r、t、l；后面各行依次写着所选取的曲线的属性参数。不知道这个能不能实现，求大神指教！再次非常感谢！

ZZXXQQ

2. (defun c:wyb ( / ang en ent hh lll os pb p1 p2 p3 p4 p5 p6 p7 p8 p9 r ss ttt w1 w)
   
3. (defun midp (pp1 pp2) (mapcar '(lambda (a b) (/ (+ a b) 2)) pp1 pp2))
   
4. (princ "\n功能：依次选取多个圆弧对象，最后在CAD内创建一个表格，将每个圆弧的属性参数放入表中。")
   
5. (setvar "cmdecho" 0)
   
6. (setq os (getvar "osmode"))
   
7. (setvar "osmode" 0)
   
8. (setq ss (list))
   
9. (while (setq s1 (entsel "\n请选择圆弧对象: "))
   
10.   (setq ss (cons (car s1) ss))
    
11. )
    
12. (setq pb (getpoint "\n表格起点: "))
    
13. (setq w1 30.0 w 17.0 hh 7.0)
    
14. (setq p1 (polar pb 0 w1))
    
15. (setq p2 (polar p1 0 w))
    
16. (setq p3 (polar p2 0 w))   
    
17. (setq p4 (polar p3 0 w))   
    
18. (setq p9 (polar pb (* pi 1.5) hh))
    
19. (setq p5 (polar p1 (* pi 1.5) hh))
    
20. (setq p6 (polar p2 (* pi 1.5) hh))
    
21. (setq p7 (polar p3 (* pi 1.5) hh))
    
22. (setq p8 (polar p4 (* pi 1.5) hh))
    
23. ;画表头
    
24. (command "pline" pb p4 p8 p9 "c")
    
25. (command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")
    
26. (command "text" "m" (midp pb p5) (/ hh 2) 0 "偏角")
    
27. (command "text" "m" (midp p1 p6) (/ hh 2) 0 "R（米）")
    
28. (command "text" "m" (midp p2 p7) (/ hh 2) 0 "T（米）")
    
29. (command "text" "m" (midp p3 p8) (/ hh 2) 0 "L（米）")
    
30. (setq ss (reverse ss))
    
31. (foreach en ss
    
32.   (if (and (setq ent (entget en)) ;获取图元的定义数据
    
33.        (member '(0 . "ARC") ent) ;;判断选取的实体是不是圆弧
    
34.       ) (progn
    
35.    ;;==================
    
36.    ;;获取圆弧属性参数: 转角、半径、切线长、弧长等
    
37.   (setq r (cdr(assoc 40 ent)) ;;半径
    
38.            st (cdr(assoc 50 ent))
    
39.            ed (cdr(assoc 51 ent)))
    
40.   (setq ang (- ed st))
    
41.   (if (< ang 0) (setq ang (+ pi pi ang)))
    
42.   (setq ttt (* (/ (sin (* 0.5 ang)) (cos (* 0.5 ang))) r)) ;;切线长
    
43.   (setq lll (* r ang)) ;;长度
    
44.   (setq pb p9 p1 p5 p2 p6 p3 p7 p4 p8)
    
45.   (setq p9 (polar pb (* pi 1.5) hh))
    
46.   (setq p5 (polar p1 (* pi 1.5) hh))
    
47.   (setq p6 (polar p2 (* pi 1.5) hh))
    
48.   (setq p7 (polar p3 (* pi 1.5) hh))
    
49.   (setq p8 (polar p4 (* pi 1.5) hh))
    
50.   (command "pline" pb p4 p8 p9 "c")
    
51.   (command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")
    
52.   (command "text" "m" (midp pb p5) (/ hh 2) 0 (angtos ang 1 5))
    
53.   (command "text" "m" (midp p1 p6) (/ hh 2) 0 (rtos r 2 3))
    
54.   (command "text" "m" (midp p2 p7) (/ hh 2) 0 (rtos ttt 2 3))
    
55.   (command "text" "m" (midp p3 p8) (/ hh 2) 0 (rtos lll 2 3))
    
56. ))
    
57. )
    
58. (setvar "osmode" os)
    
59. )
    

(defun c:wyb ( / ang en ent hh lll os pb p1 p2 p3 p4 p5 p6 p7 p8 p9 r ss ttt w1 w)<br /> (defun midp (pp1 pp2) (mapcar '(lambda (a b) (/ (+ a b) 2)) pp1 pp2))<br /> (princ "\n功能：依次选取多个圆弧对象，最后在CAD内创建一个表格，将每个圆弧的属性参数放入表中。")<br /> (setvar "cmdecho" 0)<br /> (setq os (getvar "osmode"))<br /> (setvar "osmode" 0)<br /> (setq ss (list))<br /> (while (setq s1 (entsel "\n请选择圆弧对象: "))<br />   (setq ss (cons (car s1) ss))<br /> )<br /> (setq pb (getpoint "\n表格起点: "))<br /> (setq w1 30.0 w 17.0 hh 7.0)<br /> (setq p1 (polar pb 0 w1))<br /> (setq p2 (polar p1 0 w))<br /> (setq p3 (polar p2 0 w))    <br /> (setq p4 (polar p3 0 w))    <br /> (setq p9 (polar pb (* pi 1.5) hh))<br /> (setq p5 (polar p1 (* pi 1.5) hh))<br /> (setq p6 (polar p2 (* pi 1.5) hh))<br /> (setq p7 (polar p3 (* pi 1.5) hh))<br /> (setq p8 (polar p4 (* pi 1.5) hh))<br /> ;画表头<br /> (command "pline" pb p4 p8 p9 "c")<br /> (command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")<br /> (command "text" "m" (midp pb p5) (/ hh 2) 0 "偏角")<br /> (command "text" "m" (midp p1 p6) (/ hh 2) 0 "R（米）")<br /> (command "text" "m" (midp p2 p7) (/ hh 2) 0 "T（米）")<br /> (command "text" "m" (midp p3 p8) (/ hh 2) 0 "L（米）") <br /> (setq ss (reverse ss))<br /> (foreach en ss<br />   (if (and (setq ent (entget en)) ;获取图元的定义数据<br />        (member '(0 . "ARC") ent) ;;判断选取的实体是不是圆弧<br />       ) (progn<br />    ;;==================<br />    ;;获取圆弧属性参数: 转角、半径、切线长、弧长等<br />   (setq r (cdr(assoc 40 ent)) ;;半径<br />            st (cdr(assoc 50 ent))<br />            ed (cdr(assoc 51 ent)))<br />   (setq ang (- ed st))<br />   (if (< ang 0) (setq ang (+ pi pi ang)))<br />   (setq ttt (* (/ (sin (* 0.5 ang)) (cos (* 0.5 ang))) r)) ;;切线长<br />   (setq lll (* r ang)) ;;长度<br />   (setq pb p9 p1 p5 p2 p6 p3 p7 p4 p8)<br />   (setq p9 (polar pb (* pi 1.5) hh))<br />   (setq p5 (polar p1 (* pi 1.5) hh))<br />   (setq p6 (polar p2 (* pi 1.5) hh))<br />   (setq p7 (polar p3 (* pi 1.5) hh))<br />   (setq p8 (polar p4 (* pi 1.5) hh)) <br />   (command "pline" pb p4 p8 p9 "c")<br />   (command "line" p1 p5 "" "line" p2 p6 "" "line" p3 p7 "")<br />   (command "text" "m" (midp pb p5) (/ hh 2) 0 (angtos ang 1 5))<br />   (command "text" "m" (midp p1 p6) (/ hh 2) 0 (rtos r 2 3))<br />   (command "text" "m" (midp p2 p7) (/ hh 2) 0 (rtos ttt 2 3))<br />   (command "text" "m" (midp p3 p8) (/ hh 2) 0 (rtos lll 2 3))<br /> ))<br /> )<br /> (setvar "osmode" os)<br /> )<br />

鼻祖wq

ZZXXQQ 发表于 2014-1-14 09:02

不错！非常感谢！

zwf100

这个很有用，谢谢分享