快速填充！特别快的那种！唯一要处理的是边界的问题！

cq4920

1. 
   

复制代码

2. ;;快速按名称填充
   
3. (defun C:hh(/ new)
   
4.   (if (null (setq new (getstring "\n请输入填充名称:<上一次填充图案>")))
   
5.   (princ)      
   
6.   (command "-bhatch" "p" new "1" "0"  )        
   
7.       ))
   
8. 
   
9. 
   
10. ;;绘制边界填充 实色
    
11. (defun c:1 (/ p0 p1 p2 p3 ent Pls)
    
12.     (try-osmode0);取消捕捉
    
13.   (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" "SOLID")))   
    
14.     (command "-bhatch" "properties" "SOLID" p1 "")
    
15.     (progn
    
16.     (c:zz);恢复捕捉      
    
17.     (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  "SOLID" )))
    
18.   (progn   
    
19.    (setq p0 P2)
    
20.    (setq ent (entlast))   
    
21.      (while (setq p3 (getpoint p0 "\n指定第二点"))
    
22.       (command "PLINE" p2 p3 "")
    
23.       ( SETQ P2 P3)
    
24.      )  
    
25.     (command "PLINE" p2 p0 "")
    
26.     (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 "")  )
    
27.     (progn   
    
28.      (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  "SOLID" )))      
    
29.     (setq p3 (getcorner p2 "\n第二点"))
    
30.     (command "RECTANG" p2 p3)   
    
31.     )  
    
32.     )
    
33.     (SETQ Pls (entlast))
    
34.     (command "-bhatch" "p" "SOLID"  "s" Pls "" "")
    
35.     (command "CHPROP" (entlast) ""  "C" 251 "")
    
36.     (entdel Pls)      
    
37.   ))
    
38.   (try-osmode1);恢复捕捉
    
39. )
    
40. 
    
41. 
    
42. 
    
43. (defun c:2 ()(SETQ NAME  "ANSI37"  hbl 15 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
44. (defun c:3 ()(SETQ NAME  "ANSI31"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
45. (defun c:4 ()(SETQ NAME  "ANSI34"  hbl 3 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
46. (defun c:4a ()(SETQ NAME  "ANSI34"  hbl 0.3 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
47. (defun c:5 ()(SETQ NAME  "AR-RROOF"  hbl 15 hjd 45)(Mc:hatch name hbl hjd)(princ))
    
48. (defun c:6 ()(SETQ NAME  "AR-CONC"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
49. (defun c:7 ()(SETQ NAME  "CROSS"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
50. (defun c:8 ()(SETQ NAME  "GRASS"  hbl 5 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
51. (defun c:9 ()(SETQ NAME  "AR-SAND"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
52. (defun c:10 ()(SETQ NAME  "木纹面5"  hbl 200 hjd 45)(Mc:hatch name hbl hjd)(princ))
    
53. (defun c:10a ()(SETQ NAME  "木纹面5"  hbl 50 hjd 45)(Mc:hatch name hbl hjd)(princ))
    
54. (defun c:11 ()(SETQ NAME  "dolmit"  hbl 20 hjd 90)(Mc:hatch name hbl hjd)(princ))
    
55. (defun c:12 ()(SETQ NAME  "ANSI33"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
56. (defun c:13 ()(SETQ NAME  "钢筋混凝土"  hbl 8 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
57. (defun c:14 ()(SETQ NAME  "DOTS"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
58. (defun c:15 ()(SETQ NAME  "大理石2"  hbl 1 hjd 45)(Mc:hatch name hbl hjd)(princ))
    
59. (defun c:16 ()(SETQ NAME  "CORK"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
60. (defun c:17 ()(SETQ NAME  "轻钢1：1"  hbl 70 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
61. (defun c:36z ()(SETQ NAME  "300-600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
62. (defun c:48z ()(SETQ NAME  "400-800"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
63. (defun c:300z ()(SETQ NAME  "600z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
64. (defun c:400z ()(SETQ NAME  "800Z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
65. (defun c:600z ()(SETQ NAME  "600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
66. (defun c:800z ()(SETQ NAME  "800Z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
67. (defun c:cz ()(SETQ NAME  "100"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
    
68. 
    
69. 
    
70. ;;绘制边界填充
    
71. (defun Mc:hatch (HNAME BL JD / p0 p1 p2 p3 ent Pls)
    
72.     (try-osmode0);取消捕捉
    
73.   (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" HNAME)))   
    
74.     (command "-bhatch" "properties" HNAME  BL JD p1 "")
    
75.     (progn
    
76.     (c:zz);恢复捕捉
    
77.   (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  HNAME )))  
    
78.   (progn
    
79.   (setq p0 P2)
    
80.    (setq ent (entlast))   
    
81.      (while (setq p3 (getpoint p0 "\n指定第二点"))
    
82.       (command "PLINE" p2 p3 "")
    
83.       ( SETQ P2 P3)
    
84.      )  
    
85.     (command "PLINE" p2 p0 "")
    
86.     (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 ""))
    
87.     (progn
    
88.     (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  HNAME )))      
    
89.     (setq p3 (getcorner p2 "\n第二点"))
    
90.     (command "RECTANG" p2 p3)  
    
91.   )  
    
92.   )
    
93.     (SETQ Pls (entlast))
    
94.     (command "-bhatch" "p" HNAME  BL JD "s" Pls "" "")
    
95.     (command "CHPROP" (entlast) ""  "C" 251 "")
    
96.     (entdel Pls)      
    
97.   ))
    
98.   (try-osmode1);恢复捕捉
    
99. )
    
100. 
     
101. 
     
102. ;;; 快速填充  
     
103. (defun ljx-hatch (pt name jd sca / mspace e hatchobj outlst objlst )
     
104.   (vl-load-com)
     
105.   (setq mspace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
     
106.   (setq e (bpoly pt))
     
107.   (vl-cmdf)
     
108.   (if (not (vlax-ename->vla-object e))
     
109.     (progn
     
110.       (bpoly pt)
     
111.       (vl-cmdf "")
     
112.       (setq e (entlast))
     
113.     )
     
114.   )
     
115.   (setq objlst (list (vlax-ename->vla-object e))
     
116.         hatchobj (vla-AddHatch mspace 0 name :vlax-true)
     
117.         outlst (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst))))
     
118.   )
     
119.   (vlax-safearray-fill  outlst objlst)
     
120.   (vla-appendouterloop hatchobj outlst)
     
121.   (vla-evaluate hatchobj)
     
122.   (vla-put-PatternScale hatchobj sca);;图案比例
     
123.   (vla-put-PatternAngle hatchobj (* jd (/ pi 180.0)));;图案旋转角度
     
124.   (vla-delete (vlax-ename->vla-object e))
     
125. )
     

;;快速按名称填充<br /> (defun C:hh(/ new)<br />   (if (null (setq new (getstring "\n请输入填充名称:<上一次填充图案>")))<br />   (princ)      <br />   (command "-bhatch" "p" new "1" "0"  )        <br />       ))<br /> <br /> <br /> ;;绘制边界填充 实色<br /> (defun c:1 (/ p0 p1 p2 p3 ent Pls)<br />     (try-osmode0);取消捕捉<br />   (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" "SOLID")))    <br />     (command "-bhatch" "properties" "SOLID" p1 "")<br />     (progn<br />     (c:zz);恢复捕捉      <br />     (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  "SOLID" )))<br />   (progn   <br />    (setq p0 P2)<br />    (setq ent (entlast))    <br />      (while (setq p3 (getpoint p0 "\n指定第二点"))<br />       (command "PLINE" p2 p3 "")<br />       ( SETQ P2 P3)<br />      )  <br />     (command "PLINE" p2 p0 "")<br />     (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 "")  )<br />     (progn   <br />      (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  "SOLID" )))      <br />     (setq p3 (getcorner p2 "\n第二点"))<br />     (command "RECTANG" p2 p3)    <br />     )  <br />     )<br />     (SETQ Pls (entlast))<br />     (command "-bhatch" "p" "SOLID"  "s" Pls "" "")<br />     (command "CHPROP" (entlast) ""  "C" 251 "")<br />     (entdel Pls)      <br />   ))<br />   (try-osmode1);恢复捕捉<br /> )<br /> <br /> <br /> <br /> (defun c:2 ()(SETQ NAME  "ANSI37"  hbl 15 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:3 ()(SETQ NAME  "ANSI31"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:4 ()(SETQ NAME  "ANSI34"  hbl 3 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:4a ()(SETQ NAME  "ANSI34"  hbl 0.3 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:5 ()(SETQ NAME  "AR-RROOF"  hbl 15 hjd 45)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:6 ()(SETQ NAME  "AR-CONC"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:7 ()(SETQ NAME  "CROSS"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:8 ()(SETQ NAME  "GRASS"  hbl 5 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:9 ()(SETQ NAME  "AR-SAND"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:10 ()(SETQ NAME  "木纹面5"  hbl 200 hjd 45)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:10a ()(SETQ NAME  "木纹面5"  hbl 50 hjd 45)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:11 ()(SETQ NAME  "dolmit"  hbl 20 hjd 90)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:12 ()(SETQ NAME  "ANSI33"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:13 ()(SETQ NAME  "钢筋混凝土"  hbl 8 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:14 ()(SETQ NAME  "DOTS"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:15 ()(SETQ NAME  "大理石2"  hbl 1 hjd 45)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:16 ()(SETQ NAME  "CORK"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:17 ()(SETQ NAME  "轻钢1：1"  hbl 70 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:36z ()(SETQ NAME  "300-600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:48z ()(SETQ NAME  "400-800"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:300z ()(SETQ NAME  "600z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:400z ()(SETQ NAME  "800Z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:600z ()(SETQ NAME  "600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:800z ()(SETQ NAME  "800Z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> (defun c:cz ()(SETQ NAME  "100"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))<br /> <br /> <br /> ;;绘制边界填充<br /> (defun Mc:hatch (HNAME BL JD / p0 p1 p2 p3 ent Pls)<br />     (try-osmode0);取消捕捉<br />   (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" HNAME)))    <br />     (command "-bhatch" "properties" HNAME  BL JD p1 "")<br />     (progn<br />     (c:zz);恢复捕捉<br />   (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  HNAME )))  <br />   (progn <br />   (setq p0 P2)<br />    (setq ent (entlast))    <br />      (while (setq p3 (getpoint p0 "\n指定第二点"))<br />       (command "PLINE" p2 p3 "")<br />       ( SETQ P2 P3)<br />      )  <br />     (command "PLINE" p2 p0 "")<br />     (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 ""))<br />     (progn<br />     (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  HNAME )))      <br />     (setq p3 (getcorner p2 "\n第二点"))<br />     (command "RECTANG" p2 p3)  <br />   )  <br />   )<br />     (SETQ Pls (entlast))<br />     (command "-bhatch" "p" HNAME  BL JD "s" Pls "" "")<br />     (command "CHPROP" (entlast) ""  "C" 251 "")<br />     (entdel Pls)      <br />   ))<br />   (try-osmode1);恢复捕捉<br /> )<br /> <br /> <br /> ;;; 快速填充  <br /> (defun ljx-hatch (pt name jd sca / mspace e hatchobj outlst objlst )<br />   (vl-load-com)<br />   (setq mspace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))<br />   (setq e (bpoly pt))<br />   (vl-cmdf)<br />   (if (not (vlax-ename->vla-object e))<br />     (progn<br />       (bpoly pt)<br />       (vl-cmdf "")<br />       (setq e (entlast))<br />     )<br />   )<br />   (setq objlst (list (vlax-ename->vla-object e))<br />         hatchobj (vla-AddHatch mspace 0 name :vlax-true)<br />         outlst (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst))))<br />   )<br />   (vlax-safearray-fill  outlst objlst)<br />   (vla-appendouterloop hatchobj outlst)<br />   (vla-evaluate hatchobj)<br />   (vla-put-PatternScale hatchobj sca);;图案比例<br />   (vla-put-PatternAngle hatchobj (* jd (/ pi 180.0)));;图案旋转角度<br />   (vla-delete (vlax-ename->vla-object e))<br /> )<br />

magicheno

感谢大佬分享~~~~

dasha321

谢谢大佬，很有用

alexmai

自从用动态块做填充后，填充命令基本不用

gaics

alexmai 发表于 2021-9-16 22:54
自从用动态块做填充后，填充命令基本不用

分享一下，哈哈

alexmai

gaics 发表于 2021-9-17 11:41
分享一下，哈哈

不同的填充，利用可见性分类，立面及大样图都大量使用

趣意人生

感谢大佬分享~~~~

999999

谢谢大佬的无私分享

edsion24

命令: 1 ; 错误: no function definition: TRY-OSMODE0

zys344940209

command调用就是比CAD的H要快很多