利用API的mpolygon动态填充练习

brainstorm

利用Mpolygon进行动态填充，这个结合N版的非模式对话框填充工具就可以做出比较好用的填充工具了
N版的链接 http://bbs.xdcad.net/forum.php?m ... hlight=%CC%EE%B3%E4

1. ;;;-----------------------------------------------------------
   
2. 
   
3. ;;;-----------------------------------------------------------
   
4. 
   
5. (defun zgx-add-hatch-byloop
   
6.        (mp bdlst patten scale / hch outer inner hch patten)
   
7.   (xdrx_setmark)
   
8.   (setq        outer (car bdlst)
   
9.         outer (xdrx_polyline_make
   
10.                 (xdrx_getpropertyvalue mp "MPolygonLoopAt" outer)
    
11.               )
    
12.   )
    
13.   (setq hch (xdrx_hatch_make outer))  
    
14.   (xdrx_hatch_setpattern
    
15.     hch
    
16.     patten
    
17.   )
    
18.   (xdrx_hatch_setscale
    
19.     hch
    
20.     scale
    
21.   )
    
22.   (if (and outer
    
23.            (setq inner (cadr bdlst))
    
24.       )
    
25.     (foreach n inner
    
26.       (xdrx_hatch_appendloop
    
27.         hch
    
28.         (xdrx_polyline_make
    
29.           (xdrx_getpropertyvalue mp "MPolygonLoopAt" n)
    
30.         )
    
31.       )
    
32.     )
    
33.   )
    
34.   (xdrx_getss)
    
35. )
    
36. 
    
37. 
    
38. ;;;-----------------------------------------------------------
    
39. (defun zgx-get-boundary-loop (mp pt / outer inner)
    
40.   (setq        outer
    
41.          (car (xdrx_getpropertyvalue
    
42.                 mp
    
43.                 "IsPointInsideMPolygon"
    
44.                 pt
    
45.               )
    
46.          )
    
47.   )
    
48.   (if (not (eq (type outer) 'list))
    
49.     (progn
    
50.       (setq inner (xdrx_getpropertyvalue
    
51.                     mp
    
52.                     "ChildLoops"
    
53.                     outer
    
54.                   )
    
55.       )
    
56. ;;;--移除孙子---------------------------------------------------
    
57.       (setq inner
    
58.              (vl-remove-if-not
    
59.                '(lambda        (x)
    
60.                   (eq outer (xdrx_getpropertyvalue mp "parentloop" x))
    
61.                 )
    
62.                inner
    
63.              )
    
64.       )
    
65.       (list outer inner)
    
66.     )
    
67.   )
    
68. )
    
69. ;;;-------------------------------------------------------------
    
70. ;;;-------------------------------------------------------------
    
71. 
    
72. (defun c:tt1 (/ mp bdlst tmpss oldtmpss pos curposoldtmpss *error*)
    
73.   (defun *error* (msg)
    
74.     (xdrx_pointmonitor)
    
75.     (xdrx_entity_delete tmpss)
    
76.     (xdrx_entity_delete mp)
    
77.   )
    
78.   (prompt "\nselect curves")
    
79.   (setq mp (xdrx_mpolygon_make (ssget)))
    
80. 
    
81. 
    
82.   (defun #addhatch (p)
    
83.     (setq curpos (xdrx_getpropertyvalue mp "ispointinsidempolygon" p))
    
84.     (if        (and (not (equal pos curpos))
    
85.              curpos
    
86.         )
    
87.       (progn
    
88.         (if oldtmpss
    
89.           (xdrx_entity_delete oldtmpss)
    
90.         )
    
91.         (setq
    
92.           bdlst
    
93.            (zgx-get-boundary-loop mp p)
    
94.         )
    
95.         (if bdlst
    
96.           (setq tmpss (ZGX-ADD-HATCH-BYLOOP mp bdlst "grass" 500))
    
97.         )
    
98.         (setq oldtmpss tmpss)
    
99.         (setq pos curpos)
    
100.       )                                        ;progn      
     
101.     )                                        ;if
     
102.   )
     
103.   (setq        pos t
     
104.         curpos nil
     
105.   )
     
106.   (xdrx_pointmonitor "#addhatch")
     
107.   (getpoint)
     
108.   (xdrx_pointmonitor)
     
109.   (xdrx_entity_delete mp)
     
110. )
     
111. 
     

;;;-----------------------------------------------------------<br /> <br /> ;;;-----------------------------------------------------------<br /> <br /> (defun zgx-add-hatch-byloop<br />        (mp bdlst patten scale / hch outer inner hch patten)<br />   (xdrx_setmark)<br />   (setq        outer (car bdlst)<br />         outer (xdrx_polyline_make<br />                 (xdrx_getpropertyvalue mp "MPolygonLoopAt" outer)<br />               )<br />   )<br />   (setq hch (xdrx_hatch_make outer))  <br />   (xdrx_hatch_setpattern<br />     hch<br />     patten<br />   )<br />   (xdrx_hatch_setscale<br />     hch<br />     scale<br />   )<br />   (if (and outer<br />            (setq inner (cadr bdlst))<br />       )<br />     (foreach n inner<br />       (xdrx_hatch_appendloop<br />         hch<br />         (xdrx_polyline_make<br />           (xdrx_getpropertyvalue mp "MPolygonLoopAt" n)<br />         )<br />       )<br />     )<br />   )<br />   (xdrx_getss)<br /> )<br /> <br /> <br /> ;;;-----------------------------------------------------------<br /> (defun zgx-get-boundary-loop (mp pt / outer inner)<br />   (setq        outer<br />          (car (xdrx_getpropertyvalue<br />                 mp<br />                 "IsPointInsideMPolygon"<br />                 pt<br />               )<br />          )<br />   )<br />   (if (not (eq (type outer) 'list))<br />     (progn<br />       (setq inner (xdrx_getpropertyvalue<br />                     mp<br />                     "ChildLoops"<br />                     outer<br />                   )<br />       )<br /> ;;;--移除孙子---------------------------------------------------<br />       (setq inner<br />              (vl-remove-if-not<br />                '(lambda        (x)<br />                   (eq outer (xdrx_getpropertyvalue mp "parentloop" x))<br />                 )<br />                inner<br />              )<br />       )<br />       (list outer inner)<br />     )<br />   )<br /> )<br /> ;;;-------------------------------------------------------------<br /> ;;;-------------------------------------------------------------<br /> <br /> (defun c:tt1 (/ mp bdlst tmpss oldtmpss pos curposoldtmpss *error*)<br />   (defun *error* (msg)<br />     (xdrx_pointmonitor)<br />     (xdrx_entity_delete tmpss)<br />     (xdrx_entity_delete mp)<br />   )<br />   (prompt "\nselect curves")<br />   (setq mp (xdrx_mpolygon_make (ssget)))<br /> <br /> <br />   (defun #addhatch (p)<br />     (setq curpos (xdrx_getpropertyvalue mp "ispointinsidempolygon" p))<br />     (if        (and (not (equal pos curpos))<br />              curpos<br />         )<br />       (progn<br />         (if oldtmpss<br />           (xdrx_entity_delete oldtmpss)<br />         )<br />         (setq<br />           bdlst<br />            (zgx-get-boundary-loop mp p)<br />         )<br />         (if bdlst<br />           (setq tmpss (ZGX-ADD-HATCH-BYLOOP mp bdlst "grass" 500))<br />         )<br />         (setq oldtmpss tmpss)<br />         (setq pos curpos)<br />       )                                        ;progn      <br />     )                                        ;if<br />   )<br />   (setq        pos t<br />         curpos nil<br />   )<br />   (xdrx_pointmonitor "#addhatch")<br />   (getpoint)<br />   (xdrx_pointmonitor)<br />   (xdrx_entity_delete mp)<br /> )<br /> <br />

newer

很棒的代码，
建议：
1、增加忽略内部环选项
2、前后操作有重叠的填充，合并到一个。

brainstorm

newer 发表于 2017-8-25 12:27

1、增加忽略内部环选项
这个不执行 xdrx_hatch_appendloop 就行了
2、前后操作有重叠的填充，合并到一个。
这个是啥意思？

结合论坛另一个帖子，这种方法更全面一些，链接http://bbs.xdcad.net/forum.php?m ... hlight=%CD%D8%C6%CB



;;;-----------------------------------------------------------

(defun zgx-add-hatch-byloop
       (mp bdlst patten scale / hch outer inner hch patten)
  (xdrx_setmark)
  (setq        outer (car bdlst)
        outer (xdrx_polyline_make
                (xdrx_getpropertyvalue mp "MPolygonLoopAt" outer)
              )
  )
  (setq hch (xdrx_hatch_make outer))
  (xdrx_hatch_setpattern
    hch
    patten
  )
  (xdrx_hatch_setscale
    hch
    scale
  )
  (if (and outer
           (setq inner (cadr bdlst))
      )
    (foreach n inner
      (xdrx_hatch_appendloop
        hch
        (xdrx_polyline_make
          (xdrx_getpropertyvalue mp "MPolygonLoopAt" n)
        )
      )
    )
  )
  (xdrx_getss)
)


;;;-----------------------------------------------------------
(defun zgx-get-boundary-loop (mp pt / outer inner)
  (setq        outer
         (car (xdrx_getpropertyvalue
                mp
                "IsPointInsideMPolygon"
                pt
              )
         )
  )
  (if (not (eq (type outer) 'list))
    (progn
      (setq inner (xdrx_getpropertyvalue
                    mp
                    "ChildLoops"
                    outer
                  )
      )
;;;--移除孙子---------------------------------------------------
      (setq inner
             (vl-remove-if-not
               '(lambda        (x)
                  (eq outer (xdrx_getpropertyvalue mp "parentloop" x))
                )
               inner
             )
      )
      (list outer inner)
    )
  )
)
;;;-------------------------------------------------------------
;;;-------------------------------------------------------------

(defun c:tt1 (/        mp bdlst tmpss pos curposoldtmpss *error* oldtmpss)
  (defun *error* (msg)
    (xdrx_pointmonitor)
    (xdrx_entity_delete mp tmpss)
  )
  (prompt "\nselect curves")
  (setq ss (ssget '((0 . "*line,arc,ellipse,circle"))))
  (setq ss0 (xdrx_entity_copy ss))
  (setq ss (xdrx_curve_intersectbreak ss))
  ;;所有曲线交点打断
  (setq ss (xdrx_region_make ss))
  ;;生成region
  (setq ss (xdrx_region->curve ss))
  ;;region转出曲线（保持原来边界类型）
                                        ;(setq bd (xdrx_getss))

  (setq mp (xdrx_mpolygon_make ss))
  (xdrx_entity_delete ss)

  (defun #addhatch (p)
    (setq curpos (xdrx_getpropertyvalue mp "ispointinsidempolygon" p))
    (if        (and (not (equal pos curpos))
             curpos
        )
      (progn
        (if oldtmpss
          (xdrx_entity_delete oldtmpss)
        )
        (setq
          bdlst
           (zgx-get-boundary-loop mp p)
        )
        (if bdlst
          (setq tmpss (ZGX-ADD-HATCH-BYLOOP mp bdlst "grass" 200))
        )
        (setq oldtmpss tmpss)
      )                                        ;progn      
    )                                        ;if
  )
  (setq        pos t
        curpos nil
  )
  (setq loop t)
  (while loop
    (xdrx_pointmonitor "#addhatch")
    (setq pt (getpoint))
    (xdrx_pointmonitor)
    (if        (not pt)
      (progn
        (setq loop nil)
        (if oldtmpss
          (xdrx_entity_delete oldtmpss)
        )
      )
    )
    (setq pos t
          curpos nil
    )
    (xdrx_setsstodb tmpss 0)
    (while (setq e (xdrx_getentdata 0))
      (xdrx_setenttodb e)
      (if (wcmatch (xdrx_getentdxf 0) "*LINE")
        (xdrx_entity_delete e)
      )
    )
    (setq oldtmpss nil)
  )


  (xdrx_entity_delete mp)
  (xdrx_setsstodb tmpss 0)
  (while (setq e (xdrx_getentdata 0))
    (xdrx_setenttodb e)
    (if        (wcmatch (xdrx_getentdxf 0) "*LINE")
      (xdrx_entity_delete e)
    )
  )
)

newer

brainstorm 发表于 2017-8-25 17:06

合并的意思如下图，
红色的是先点选画的填充，
在点选画黄的填充时候， 结果把黄色和红色的合并到一起。这样保证填充最大（如果没特殊要求时候）
这样的好处是，可以通过细小的边界合并出复杂的大的边界的填充。
或者说，对话框给个合并临近的开关。

比如下面的图，我想画个黄色加上红色区域的填充，还不想临时隐藏中间的直线边界，如果用点选的画是 直接画不出的，要点两个边界，画两个填充。

brainstorm

newer 发表于 2017-8-25 17:25

明白了 谢谢 我有空一起试试

longer1000

高手如云啊啊