cq4920 发表于 2021-9-14 15:38:13

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



;;快速按名称填充
(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_entent) """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" HNAMEBL 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_entent) """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" HNAMEBL 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-filloutlst 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))
)

magicheno 发表于 2021-9-14 19:22:58

感谢大佬分享~~~~

dasha321 发表于 2021-9-15 12:35:04

谢谢大佬，很有用

alexmai 发表于 2021-9-16 22:54:51

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

gaics 发表于 2021-9-17 11:41:41

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

分享一下，哈哈

alexmai 发表于 2021-9-17 21:50:12

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

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

趣意人生 发表于 2021-9-21 11:22:41

感谢大佬分享~~~~

999999 发表于 2022-4-13 00:39:01

谢谢大佬的无私分享

edsion24 发表于 2022-4-13 09:59:53

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

zys344940209 发表于 2022-5-9 19:05:01

command调用就是比CAD的H要快很多
页: [1]
查看完整版本: 快速填充！特别快的那种！唯一要处理的是边界的问题！