把此贴删除了

wowan1314

就考虑你给的那几种情况？

多边形到底是多少边？ 十字线的角度是根据那条边定？

感觉要用到vla-IntersectWith这个函数。

wowan1314

500w008 发表于 2013-8-1 19:06
多边形 最多 6多边吧 其实可以忽略掉短边 老大

我简单的写个。 你参考的自己调整下。

2. (defun c:t11 (/ ss lst p1 p2 p3)
   
3.     (setq en (vlax-ename->vla-object(car(entsel "\n选择多边形:")))
   
4.         pt(getpoint "\n指定曲线内一点:")
   
5.     )
   
6.     (if (and en pt)
   
7.         (progn
   
8.             (setq p1 (vlax-curve-getclosestpointto en pt))
   
9.             (command "LINE" p1 pt "")
   
10.             (setq x1 (vlax-ename->vla-object(setq xx (entlast))))
    
11.             (setq p2 (vlax-invoke en 'intersectwith x1 acextendotherentity))
    
12.             (setq p1 (list (car p2) (cadr p2)(caddr p2)) p2 (cdddr p2))
    
13.             (command "rotate" xx "" pt "90")
    
14.             (setq p3 (vlax-invoke en 'intersectwith x1 acextendotherentity))
    
15.             (setq p4 (list (car p3) (cadr p3)(caddr p3)) p3 (cdddr p3))
    
16.             (command "LINE" p1 p2 "")
    
17.             (command "LINE" p3 p4 "")
    
18.             (command "ERASE" xx "")
    
19.             (list(distance p1 p2)(distance p3 p4));返回两距离
    
20.         )
    
21.     )
    
22. )

(defun c:t11 (/ ss lst p1 p2 p3) <br />     (setq en (vlax-ename->vla-object(car(entsel "\n选择多边形:")))<br />         pt(getpoint "\n指定曲线内一点:")<br />     )<br />     (if (and en pt)<br />         (progn<br />             (setq p1 (vlax-curve-getclosestpointto en pt))<br />             (command "LINE" p1 pt "")<br />             (setq x1 (vlax-ename->vla-object(setq xx (entlast))))<br />             (setq p2 (vlax-invoke en 'intersectwith x1 acextendotherentity))<br />             (setq p1 (list (car p2) (cadr p2)(caddr p2)) p2 (cdddr p2))<br />             (command "rotate" xx "" pt "90")<br />             (setq p3 (vlax-invoke en 'intersectwith x1 acextendotherentity))<br />             (setq p4 (list (car p3) (cadr p3)(caddr p3)) p3 (cdddr p3))<br />             (command "LINE" p1 p2 "")<br />             (command "LINE" p3 p4 "")<br />             (command "ERASE" xx "")<br />             (list(distance p1 p2)(distance p3 p4));返回两距离<br />         )<br />     )<br /> )