求教，lisp有没有简单的方式表述我这个想法

newer

1121443108qaz 发表于 2018-3-26 16:21
看着可行，我试试

按照marting的思路，API写了个


XD::Pnts:Extremum 函数见：http://bbs.xdcad.net/thread-715128-1-1.html

1. (defun c:tt ()
   
2.   (setq tf t)
   
3.   (while (and tf
   
4.               (setq e
   
5.                      (car
   
6.                        (xdrx_entsel "\n拾取最外边界<退出>:" '((0 . "*line,circle,ellipse")))
   
7.                      )
   
8.               )
   
9.          )
   
10.     (if (xdrx_curve_isclosed e)
    
11.       (setq tf nil)
    
12.       (xdrx_prompt "\n边界不闭合，重选.")
    
13.     )
    
14.   )
    
15.   (if (and (not tf)
    
16.            (setq pts (xdrx_getsamplept e))
    
17.            (setq ss (ssget "wp" pts '((0 . "*polyline,circle,ellipse"))))
    
18.       )
    
19.     (progn
    
20.       (xdrx_begin)
    
21.       (mapcar
    
22.         '(lambda (x)
    
23.            (if (xdrx_curve_isclosed x)
    
24.              (progn (setq typ (car (xdrx_object_classname x)))
    
25.                     (cond ((wcmatch typ "CIRCLE,ELLIPSE")
    
26.                            (setq pt (nth 3 (xdrx_entity_getgrippoint x)))
    
27.                           )
    
28.                           ((= typ "SPLINE"))
    
29.                           ((wcmatch typ "*POLYLINE")
    
30.                            (setq pts (xdrx_getpropertyvalue x "vertices")
    
31.                                  pt  (xd::pnts:extremum pts '> '> t)
    
32.                            )
    
33.                           )
    
34.                     )
    
35.                     (if (and (setq gray (xdge::constructor "kRay3d"
    
36.                                                            pt
    
37.                                                            (polar pt (/ pi 2.0) 1.0)
    
38.                                         )
    
39.                              )
    
40.                              (setq ints (xdrx_entity_intersectwith gray e))
    
41.                              (setq ints (car ints))
    
42.                              (or (setq ss1 (ssget "f"
    
43.                                                   (list pt ints)
    
44.                                                   '((0 . "CIRCLE,ELLIPSE,*POLYLINE"))
    
45.                                            )
    
46.                                  )
    
47.                                  (progn (setq ss1 (ssadd)) (ssadd e ss1) t)
    
48.                              )
    
49.                         )
    
50.                       (progn (ssdel x ss1)
    
51.                              (ssadd e ss1)
    
52.                              (setq ints (xdrx_getinters (list pt ints) ss1)
    
53.                                    ints (xdrx_points_sortoncurve gray ints)
    
54.                                    ints (caar ints)
    
55.                              )
    
56.                              (xdrx_line_make pt ints)
    
57.                       )
    
58.                     )
    
59.                     (xdge::free gray)
    
60.              )
    
61.            )
    
62.          )
    
63.         (xdrx_pickset->ents ss)
    
64.       )
    
65.       (xdrx_end)
    
66.     )
    
67.   )
    
68.   (princ)
    
69. )
    
70. 
    

(defun c:tt ()<br />   (setq tf t)<br />   (while (and tf<br />               (setq e<br />                      (car<br />                        (xdrx_entsel "\n拾取最外边界<退出>:" '((0 . "*line,circle,ellipse")))<br />                      )<br />               )<br />          )<br />     (if (xdrx_curve_isclosed e)<br />       (setq tf nil)<br />       (xdrx_prompt "\n边界不闭合，重选.")<br />     )<br />   )<br />   (if (and (not tf)<br />            (setq pts (xdrx_getsamplept e))<br />            (setq ss (ssget "wp" pts '((0 . "*polyline,circle,ellipse"))))<br />       )<br />     (progn<br />       (xdrx_begin)<br />       (mapcar<br />         '(lambda (x)<br />            (if (xdrx_curve_isclosed x)<br />              (progn (setq typ (car (xdrx_object_classname x)))<br />                     (cond ((wcmatch typ "CIRCLE,ELLIPSE")<br />                            (setq pt (nth 3 (xdrx_entity_getgrippoint x)))<br />                           )<br />                           ((= typ "SPLINE"))<br />                           ((wcmatch typ "*POLYLINE")<br />                            (setq pts (xdrx_getpropertyvalue x "vertices")<br />                                  pt  (xd::pnts:extremum pts '> '> t)<br />                            )<br />                           )<br />                     )<br />                     (if (and (setq gray (xdge::constructor "kRay3d"<br />                                                            pt<br />                                                            (polar pt (/ pi 2.0) 1.0)<br />                                         )<br />                              )<br />                              (setq ints (xdrx_entity_intersectwith gray e))<br />                              (setq ints (car ints))<br />                              (or (setq ss1 (ssget "f"<br />                                                   (list pt ints)<br />                                                   '((0 . "CIRCLE,ELLIPSE,*POLYLINE"))<br />                                            )<br />                                  )<br />                                  (progn (setq ss1 (ssadd)) (ssadd e ss1) t)<br />                              )<br />                         )<br />                       (progn (ssdel x ss1)<br />                              (ssadd e ss1)<br />                              (setq ints (xdrx_getinters (list pt ints) ss1)<br />                                    ints (xdrx_points_sortoncurve gray ints)<br />                                    ints (caar ints)<br />                              )<br />                              (xdrx_line_make pt ints)<br />                       )<br />                     )<br />                     (xdge::free gray)<br />              )<br />            )<br />          )<br />         (xdrx_pickset->ents ss)<br />       )<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

1121443108qaz

newer 发表于 2018-3-27 00:59
按照marting的思路，API写了个

n版厉害，这么晚还研究

zyclyl

好像骷髅脸呀。。。。

marting

这样画出的填充有个致命的缺陷，就是没有面积。