[LISP]请指高手如何求任意一多义线中圆弧的四分圆点的坐标值

zjyangxyz

请指高手如何求任意一多义线中圆弧的四分圆点的坐标值，如上图所示！

zjyangxyz

高手们怎么都不指点一下呢？

Ea

先求圆心和半径

mkhsj928

2. 条件不足，园的1/4点无穷个哈！
3. (defun c:test( / m_plent m_hdlist m_pt1 m_pt2 m_pt3 m_xc m_radius m_ptcenter m_angle m_taglength m_arclength)
4.   (setq m_plent (car (entsel"\n请选择含圆弧的多段线:")))
5.   (if (setq m_hdlist (m_searchhd m_plent));;求出多义线中组码42值不等于0的所有点表
6.     (repeat (length m_hdlist)
7.       (setq m_pt1 (nth 1 (car m_hdlist)))
8.       (setq m_pt2 (nth 2 (car m_hdlist)))
9.       (setq m_xc (distance m_pt1 m_pt2));;弦长
10.       (setq m_radius (abs (/ (* m_xc (1+ (* (caar m_hdlist)(caar m_hdlist)))) (* 4 (caar m_hdlist)))));;半径R
11.       (setq m_pt3 (polar m_pt1 (angle m_pt1 m_pt2) (/ m_xc 2.0)))
12.       (if (> 0.0 (caar m_hdlist))
13. (setq m_ptcenter (polar m_pt3 (- (angle m_pt1 m_pt2) (angtof "90"))  (- m_radius (/ (* (abs (caar m_hdlist)) m_xc) 2.0))))
14. (setq m_ptcenter (polar m_pt3 (- (angle m_pt1 m_pt2) (angtof "270")) (- m_radius (/ (* (abs (caar m_hdlist)) m_xc) 2.0))))
15.       )
16.       (setq m_angle (abs (- (angle m_ptcenter m_pt1)(angle m_ptcenter m_pt2))));;弧角弧度
17.       ;;(if (< m_angle 0) (setq m_angle (+ (* 2 pi) m_angle)))
18.       (setq m_taglength (* m_radius (/ (sin (/ m_angle 2.0))(cos (/ m_angle 2.0)))));;半切线长
19.       (setq m_arclength (* m_radius m_angle));;弧长
20.       (setq m_len (vlax-curve-getdistatpoint (vlax-ename->vla-object m_plent) m_pt1))
21.       (setq m_pt1 (vlax-curve-getpointatdist (vlax-ename->vla-object m_plent) (+ m_len (/ m_arclength 3))))
22.       (m_drawpc m_pt1)
23.       (setq m_pt1 (vlax-curve-getpointatdist (vlax-ename->vla-object m_plent) (+ m_len (* 2 (/ m_arclength 3)))))
24.       (m_drawpc m_pt1)
25.       
26.       (setq m_hdlist (cdr m_hdlist))
27.     )
28.     (princ" ——>多段线中未包括圆弧！")
29.   )
30. )
31. (defun m_searchhd(m_plent / m_pttab m_pt1 m_pt2 m_tmp m_ptlist)
32.   ;;搜索多义线实体中是否有圆弧段，返回(((组码42值(非零) （点座标） （下一点座标)) ...)
33.   (setq m_pttab (entget m_plent))
34.   (while (setq m_pt1 (assoc '10 m_pttab))
35.     (setq m_tmp (assoc '42 m_pttab))
36.     (if (/= 0.0 (cdr m_tmp))
37.       (if (setq m_pt2 (assoc '10 (cdr (member m_pt1 m_pttab))))
38. (progn
39.    (setq m_pt1 (list (nth 1 m_pt1) (nth 2 m_pt1)))
40.    (setq m_pt2 (list (nth 1 m_pt2) (nth 2 m_pt2)))
41.    (setq m_ptlist (append m_ptlist (list (list (cdr m_tmp) m_pt1 m_pt2))))
42. )
43.       )
44.     )
45.     (setq m_pttab (cdr (member m_tmp m_pttab)))
46.   )
47.   m_ptlist
48. )
49. (defun m_drawpc(pt / mspace m_vlaline1 m_vlaline2 m_vlacircle m_sstmp m_linelen)
50.   
51.     (setq m_sstmp (ssadd))
52.   
53.     (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
54.     (setq m_linelen 5)
55.     (setq m_vlaline1 (vla-addline mspace (vlax-3d-point (polar pt (angtof "45") m_linelen))
56.       (vlax-3d-point (polar pt (angtof "225") m_linelen)));;创建一条直线
57.     )
58.     (vla-put-color m_vlaline1 acgreen);;颜色－绿色
59.     (vla-put-lineweight m_vlaline1 aclnwt030);;设置线宽
60.     (ssadd (entlast) m_sstmp)
61.     (setq m_vlaline2 (vla-addline mspace (vlax-3d-point (polar pt (angtof "135") m_linelen))
62.       (vlax-3d-point (polar pt (angtof "315") m_linelen)))
63.     )
64.     (vla-put-color m_vlaline2 acgreen)
65.     (vla-put-lineweight m_vlaline2 aclnwt030)
66.     (ssadd (entlast) m_sstmp)
67.   
68.     (setq m_vlacircle (vla-addcircle mspace (vlax-3d-point pt) (/ m_linelen 2.0)));;创建一个园
69.     (vla-put-color m_vlacircle acyellow);;颜色－黄色
70.     (vla-put-lineweight m_vlacircle aclnwt030)
71.     (ssadd (entlast) m_sstmp)
72.     m_sstmp
73. )

条件不足，园的1/4点无穷个哈！ (defun c:test( / m_plent m_hdlist m_pt1 m_pt2 m_pt3 m_xc m_radius m_ptcenter m_angle m_taglength m_arclength)   (setq m_plent (car (entsel"\n请选择含圆弧的多段线:")))   (if (setq m_hdlist (m_searchhd m_plent));;求出多义线中组码42值不等于0的所有点表     (repeat (length m_hdlist)       (setq m_pt1 (nth 1 (car m_hdlist)))       (setq m_pt2 (nth 2 (car m_hdlist)))       (setq m_xc (distance m_pt1 m_pt2));;弦长       (setq m_radius (abs (/ (* m_xc (1+ (* (caar m_hdlist)(caar m_hdlist)))) (* 4 (caar m_hdlist)))));;半径R       (setq m_pt3 (polar m_pt1 (angle m_pt1 m_pt2) (/ m_xc 2.0)))       (if (> 0.0 (caar m_hdlist)) (setq m_ptcenter (polar m_pt3 (- (angle m_pt1 m_pt2) (angtof "90"))  (- m_radius (/ (* (abs (caar m_hdlist)) m_xc) 2.0)))) (setq m_ptcenter (polar m_pt3 (- (angle m_pt1 m_pt2) (angtof "270")) (- m_radius (/ (* (abs (caar m_hdlist)) m_xc) 2.0))))       )       (setq m_angle (abs (- (angle m_ptcenter m_pt1)(angle m_ptcenter m_pt2))));;弧角弧度       ;;(if (< m_angle 0) (setq m_angle (+ (* 2 pi) m_angle)))       (setq m_taglength (* m_radius (/ (sin (/ m_angle 2.0))(cos (/ m_angle 2.0)))));;半切线长       (setq m_arclength (* m_radius m_angle));;弧长       (setq m_len (vlax-curve-getdistatpoint (vlax-ename->vla-object m_plent) m_pt1))       (setq m_pt1 (vlax-curve-getpointatdist (vlax-ename->vla-object m_plent) (+ m_len (/ m_arclength 3))))       (m_drawpc m_pt1)       (setq m_pt1 (vlax-curve-getpointatdist (vlax-ename->vla-object m_plent) (+ m_len (* 2 (/ m_arclength 3)))))       (m_drawpc m_pt1)              (setq m_hdlist (cdr m_hdlist))     )     (princ" ——>多段线中未包括圆弧！")   ) ) (defun m_searchhd(m_plent / m_pttab m_pt1 m_pt2 m_tmp m_ptlist)   ;;搜索多义线实体中是否有圆弧段，返回(((组码42值(非零) （点座标） （下一点座标)) ...)   (setq m_pttab (entget m_plent))   (while (setq m_pt1 (assoc '10 m_pttab))     (setq m_tmp (assoc '42 m_pttab))     (if (/= 0.0 (cdr m_tmp))       (if (setq m_pt2 (assoc '10 (cdr (member m_pt1 m_pttab)))) (progn    (setq m_pt1 (list (nth 1 m_pt1) (nth 2 m_pt1)))    (setq m_pt2 (list (nth 1 m_pt2) (nth 2 m_pt2)))    (setq m_ptlist (append m_ptlist (list (list (cdr m_tmp) m_pt1 m_pt2)))) )       )     )     (setq m_pttab (cdr (member m_tmp m_pttab)))   )   m_ptlist ) (defun m_drawpc(pt / mspace m_vlaline1 m_vlaline2 m_vlacircle m_sstmp m_linelen)        (setq m_sstmp (ssadd))        (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))     (setq m_linelen 5)     (setq m_vlaline1 (vla-addline mspace (vlax-3d-point (polar pt (angtof "45") m_linelen))       (vlax-3d-point (polar pt (angtof "225") m_linelen)));;创建一条直线     )     (vla-put-color m_vlaline1 acgreen);;颜色－绿色     (vla-put-lineweight m_vlaline1 aclnwt030);;设置线宽     (ssadd (entlast) m_sstmp)     (setq m_vlaline2 (vla-addline mspace (vlax-3d-point (polar pt (angtof "135") m_linelen))       (vlax-3d-point (polar pt (angtof "315") m_linelen)))     )     (vla-put-color m_vlaline2 acgreen)     (vla-put-lineweight m_vlaline2 aclnwt030)     (ssadd (entlast) m_sstmp)        (setq m_vlacircle (vla-addcircle mspace (vlax-3d-point pt) (/ m_linelen 2.0)));;创建一个园     (vla-put-color m_vlacircle acyellow);;颜色－黄色     (vla-put-lineweight m_vlacircle aclnwt030)     (ssadd (entlast) m_sstmp)     m_sstmp )

zjyangxyz

多谢3楼的朋友！不过我运行时出错，提示如下:

no function definition: VLAX-ENAME->VLA-OBJECT

Andyhon

先 Run 这个  (vl-load-com)

 

无痕

简单一点的，可以炸开，取所有ａｒｃ

分别求象限点