明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 246|回复: 5

[源码] 快速填充!特别快的那种!唯一要处理的是边界的问题!

[复制链接]
发表于 2021-9-14 15:38 | 显示全部楼层 |阅读模式

复制代码
[code="lisp] ;;快速按名称填充
(defun C:hh(/ new)
  (if (null (setq new (getstring "\n请输入填充名称:<上一次填充图案>")))
  (princ)      
  (command "-bhatch" "p" new "1" "0"  )        
      ))


;;绘制边界填充 实色
(defun c:1 (/ p0 p1 p2 p3 ent Pls)
    (try-osmode0);取消捕捉
  (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" "SOLID")))   
    (command "-bhatch" "properties" "SOLID" p1 "")
    (progn
    (c:zz);恢复捕捉      
    (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  "SOLID" )))
  (progn   
   (setq p0 P2)
   (setq ent (entlast))   
     (while (setq p3 (getpoint p0 "\n指定第二点"))
      (command "PLINE" p2 p3 "")
      ( SETQ P2 P3)
     )  
    (command "PLINE" p2 p0 "")
    (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 "")  )
    (progn   
     (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  "SOLID" )))      
    (setq p3 (getcorner p2 "\n第二点"))
    (command "RECTANG" p2 p3)   
    )  
    )
    (SETQ Pls (entlast))
    (command "-bhatch" "p" "SOLID"  "s" Pls "" "")
    (command "CHPROP" (entlast) ""  "C" 251 "")
    (entdel Pls)      
  ))
  (try-osmode1);恢复捕捉
)



(defun c:2 ()(SETQ NAME  "ANSI37"  hbl 15 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:3 ()(SETQ NAME  "ANSI31"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:4 ()(SETQ NAME  "ANSI34"  hbl 3 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:4a ()(SETQ NAME  "ANSI34"  hbl 0.3 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:5 ()(SETQ NAME  "AR-RROOF"  hbl 15 hjd 45)(Mc:hatch name hbl hjd)(princ))
(defun c:6 ()(SETQ NAME  "AR-CONC"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:7 ()(SETQ NAME  "CROSS"  hbl 10 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:8 ()(SETQ NAME  "GRASS"  hbl 5 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:9 ()(SETQ NAME  "AR-SAND"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:10 ()(SETQ NAME  "木纹面5"  hbl 200 hjd 45)(Mc:hatch name hbl hjd)(princ))
(defun c:10a ()(SETQ NAME  "木纹面5"  hbl 50 hjd 45)(Mc:hatch name hbl hjd)(princ))
(defun c:11 ()(SETQ NAME  "dolmit"  hbl 20 hjd 90)(Mc:hatch name hbl hjd)(princ))
(defun c:12 ()(SETQ NAME  "ANSI33"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:13 ()(SETQ NAME  "钢筋混凝土"  hbl 8 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:14 ()(SETQ NAME  "DOTS"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:15 ()(SETQ NAME  "大理石2"  hbl 1 hjd 45)(Mc:hatch name hbl hjd)(princ))
(defun c:16 ()(SETQ NAME  "CORK"  hbl 2 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:17 ()(SETQ NAME  "轻钢1:1"  hbl 70 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:36z ()(SETQ NAME  "300-600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:48z ()(SETQ NAME  "400-800"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:300z ()(SETQ NAME  "600z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:400z ()(SETQ NAME  "800Z"  hbl 0.5 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:600z ()(SETQ NAME  "600z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:800z ()(SETQ NAME  "800Z"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))
(defun c:cz ()(SETQ NAME  "100"  hbl 1 hjd 0)(Mc:hatch name hbl hjd)(princ))


;;绘制边界填充
(defun Mc:hatch (HNAME BL JD / p0 p1 p2 p3 ent Pls)
    (try-osmode0);取消捕捉
  (if (setq p1 (getpoint (strcat "\n 指定封闭填充区域>>>填充图案为>>" HNAME)))   
    (command "-bhatch" "properties" HNAME  BL JD p1 "")
    (progn
    (c:zz);恢复捕捉
  (if (setq p2 (getpoint (strcat "\n指定填充区域第一点>>>填充图案为>>>"  HNAME )))  
  (progn
  (setq p0 P2)
   (setq ent (entlast))   
     (while (setq p3 (getpoint p0 "\n指定第二点"))
      (command "PLINE" p2 p3 "")
      ( SETQ P2 P3)
     )  
    (command "PLINE" p2 p0 "")
    (COMMAND "pedit" "m" (last_ent  ent) ""  "j" 0.5 ""))
    (progn
    (setq p2 (getpoint (strcat "\n绘制矩形区域>>>填充图案>>>"  HNAME )))      
    (setq p3 (getcorner p2 "\n第二点"))
    (command "RECTANG" p2 p3)  
  )  
  )
    (SETQ Pls (entlast))
    (command "-bhatch" "p" HNAME  BL JD "s" Pls "" "")
    (command "CHPROP" (entlast) ""  "C" 251 "")
    (entdel Pls)      
  ))
  (try-osmode1);恢复捕捉
)


;;; 快速填充  
(defun ljx-hatch (pt name jd sca / mspace e hatchobj outlst objlst )
  (vl-load-com)
  (setq mspace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  (setq e (bpoly pt))
  (vl-cmdf)
  (if (not (vlax-ename->vla-object e))
    (progn
      (bpoly pt)
      (vl-cmdf "")
      (setq e (entlast))
    )
  )
  (setq objlst (list (vlax-ename->vla-object e))
        hatchobj (vla-AddHatch mspace 0 name :vlax-true)
        outlst (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst))))
  )
  (vlax-safearray-fill  outlst objlst)
  (vla-appendouterloop hatchobj outlst)
  (vla-evaluate hatchobj)
  (vla-put-PatternScale hatchobj sca);;图案比例
  (vla-put-PatternAngle hatchobj (* jd (/ pi 180.0)));;图案旋转角度
  (vla-delete (vlax-ename->vla-object e))
)
[/code]
发表于 2021-9-14 19:22 | 显示全部楼层
感谢大佬分享~~~~
发表于 2021-9-15 12:35 | 显示全部楼层
谢谢大佬,很有用
发表于 2021-9-16 22:54 | 显示全部楼层
自从用动态块做填充后,填充命令基本不用
发表于 2021-9-17 11:41 | 显示全部楼层
alexmai 发表于 2021-9-16 22:54
自从用动态块做填充后,填充命令基本不用

分享一下,哈哈
发表于 2021-9-17 21:50 | 显示全部楼层
gaics 发表于 2021-9-17 11:41
分享一下,哈哈

不同的填充,利用可见性分类,立面及大样图都大量使用
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2020 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2021-9-17 23:55 , Processed in 0.493772 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表