求助，麻烦帮忙增加一个记忆上一次填充的功能 怎么折腾都弄不好 感谢大佬

pizi158545086

(defun C:12 (/ ent ss tc_name tcm tcb tcj tc_col)
        (setvar "cmdecho" 0)
        (princ "继承填充（先选择填充，再选择要填充的区域）")
        (setq ent (entsel "\n选择填充对象<退出>:"))
        (setq tcm (cdr (assoc 2 (entget (car ent)))));获取填充图案的名称
        (setq tc_name (cdr (assoc 8 (entget (car ent)))));获取填充图案的图层名
        (if (= tcm "SOLID")
                (setvar "hpname" tcm)
                (progn
                        (setq tcb (cdr (assoc 41 (entget (car ent)))));获取填充图案的比例
                        (setq tcj (cdr (assoc 52 (entget (car ent)))));获取填充图案的角度（这个值是以弧度返回的）
                        (setq tc_col (cdr (assoc 62 (entget (car ent)))));获取填充图案的颜色
                        (setvar "hpname" tcm)
                        (setvar "hpscale" tcb)
                        (setvar "hpang" tcj)
                )
        )
        (while (JCTC_z))
        (princ)
)

(defun JCTC_z ()
  (setvar "cmdecho" 0)
  (defun *Error* (msg)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
      (princ))
  );defun *Error*
  (setvar "measurement" 1)
  (setvar "measureinit" 1)
  (princ "\n请选择填充区域：(提示:空选则为拾取内部点填充）")
  (if (setq ss (ssget))
      (command "bhatch" "s" ss "" "")
      (progn
          (princ "\n请拾取填充内部点：")
          (command "bhatch" pause pause)
       );progn
   );if
  (command "_.undo" "_group")
  (command "change" (entlast) "" "P" "la" tc_name ""
           "change" (entlast) "" "P" "c" "bylayer" "")
  (command "_.undo" "_end")
  (princ)
)


类似图片增加一个空格使用上一次的填充

ssyfeng

随便修改了一下，凑合着用吧

ssyfeng

又是AI写的代码？

pizi158545086

ssyfeng 发表于 2025-3-11 15:36
又是AI写的代码？

不是  站里找的代码

pizi158545086

ssyfeng 发表于 2025-3-11 16:24
随便修改了一下，凑合着用吧

非常感谢 ，我想问下填充的颜色变成8号色，怎么可以改成随原填充的颜色呢？

ssyfeng

pizi158545086 发表于 2025-3-11 16:30
非常感谢 ，我想问下填充的颜色变成8号色，怎么可以改成随原填充的颜色呢？

已更新，重新下载试试

pizi158545086

ssyfeng 发表于 2025-3-11 16:52
已更新，重新下载试试

可以了 非常感谢

xyp1964

1. (defun c:tt ()
   
2.   (defun aaa ()
   
3.     (setvar 'cecolor (itoa co))
   
4.     (setvar 'clayer la)
   
5.     (if (= hn "_USER")
   
6.       (command "-bhatch" "p" "U" dr hs "y" "")
   
7.       (command "-bhatch" "p" hn hs dr "")
   
8.     )
   
9.     (if (setq ss (ssget))
   
10.       (command "-bhatch" "s" ss "" "")
    
11.       (progn
    
12.         (prompt "\n请拾取填充内部点：\n")
    
13.         (command "bhatch" pause)
    
14.         (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
    
15.       )
    
16.     )
    
17.   )
    
18.   (if (and (setq s1 (car (entsel "\n选择填充源图案[空格使用上次设置]: ")))
    
19.            (= (cdr (assoc 0 (entget s1))) "HATCH")
    
20.       )
    
21.     (setq ob (vlax-ename->vla-object s1)
    
22.           hn (vla-get-patternname ob)
    
23.           hs (vla-get-patternscale ob)
    
24.           ha (vla-get-patternangle ob)
    
25.           la (vla-get-layer ob)
    
26.           co (vla-get-color ob)
    
27.           dr (* 180 (/ ha pi))
    
28.           aa (aaa)
    
29.     )
    
30.     (aaa)
    
31.   )
    
32.   (princ)
    
33. )

(defun c:tt ()<br />   (defun aaa ()<br />     (setvar 'cecolor (itoa co))<br />     (setvar 'clayer la)<br />     (if (= hn "_USER")<br />       (command "-bhatch" "p" "U" dr hs "y" "")<br />       (command "-bhatch" "p" hn hs dr "")<br />     )<br />     (if (setq ss (ssget))<br />       (command "-bhatch" "s" ss "" "")<br />       (progn<br />         (prompt "\n请拾取填充内部点：\n")<br />         (command "bhatch" pause)<br />         (while (> (getvar "CMDACTIVE") 0) (command PAUSE))<br />       )<br />     )<br />   )<br />   (if (and (setq s1 (car (entsel "\n选择填充源图案[空格使用上次设置]: ")))<br />            (= (cdr (assoc 0 (entget s1))) "HATCH")<br />       )<br />     (setq ob (vlax-ename->vla-object s1)<br />           hn (vla-get-patternname ob)<br />           hs (vla-get-patternscale ob)<br />           ha (vla-get-patternangle ob)<br />           la (vla-get-layer ob)<br />           co (vla-get-color ob)<br />           dr (* 180 (/ ha pi))<br />           aa (aaa)<br />     )<br />     (aaa)<br />   )<br />   (princ)<br /> )

pizi158545086

xyp1964 发表于 2025-3-11 17:04

这个会改变了默认的绘图图层和颜色

xyp1964

pizi158545086 发表于 2025-3-11 17:30
这个会改变了默认的绘图图层和颜色

1. (defun c:tt ()
   
2.   "记忆填充"
   
3.   (setq oco (getvar 'cecolor)
   
4.         ola (getvar 'clayer)
   
5.   )
   
6.   (defun aaa ()
   
7.     (setvar 'cecolor (itoa co))
   
8.     (setvar 'clayer la)
   
9.     (if (= hn "_USER")
   
10.       (command "-bhatch" "p" "U" dr hs "y" "")
    
11.       (command "-bhatch" "p" hn hs dr "")
    
12.     )
    
13.     (if (setq ss (ssget))
    
14.       (command "-bhatch" "s" ss "" "")
    
15.       (progn
    
16.         (prompt "\n请拾取填充内部点：\n")
    
17.         (command "bhatch" pause)
    
18.         (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
    
19.       )
    
20.     )
    
21.   )
    
22.   (if (and (setq s1 (car (entsel "\n选择填充源图案[空格使用上次设置]: ")))
    
23.            (= (cdr (assoc 0 (entget s1))) "HATCH")
    
24.       )
    
25.     (setq ob (vlax-ename->vla-object s1)
    
26.           hn (vla-get-patternname ob)
    
27.           hs (vla-get-patternscale ob)
    
28.           ha (vla-get-patternangle ob)
    
29.           la (vla-get-layer ob)
    
30.           co (vla-get-color ob)
    
31.           dr (* 180 (/ ha pi))
    
32.           aa (aaa)
    
33.     )
    
34.     (aaa)
    
35.   )
    
36.   (setvar 'cecolor oco)
    
37.   (setvar 'clayer ola)
    
38.   (princ)
    
39. )

(defun c:tt ()<br />   "记忆填充"<br />   (setq oco (getvar 'cecolor)<br />         ola (getvar 'clayer)<br />   )<br />   (defun aaa ()<br />     (setvar 'cecolor (itoa co))<br />     (setvar 'clayer la)<br />     (if (= hn "_USER")<br />       (command "-bhatch" "p" "U" dr hs "y" "")<br />       (command "-bhatch" "p" hn hs dr "")<br />     )<br />     (if (setq ss (ssget))<br />       (command "-bhatch" "s" ss "" "")<br />       (progn<br />         (prompt "\n请拾取填充内部点：\n")<br />         (command "bhatch" pause)<br />         (while (> (getvar "CMDACTIVE") 0) (command PAUSE))<br />       )<br />     )<br />   )<br />   (if (and (setq s1 (car (entsel "\n选择填充源图案[空格使用上次设置]: ")))<br />            (= (cdr (assoc 0 (entget s1))) "HATCH")<br />       )<br />     (setq ob (vlax-ename->vla-object s1)<br />           hn (vla-get-patternname ob)<br />           hs (vla-get-patternscale ob)<br />           ha (vla-get-patternangle ob)<br />           la (vla-get-layer ob)<br />           co (vla-get-color ob)<br />           dr (* 180 (/ ha pi))<br />           aa (aaa)<br />     )<br />     (aaa)<br />   )<br />   (setvar 'cecolor oco)<br />   (setvar 'clayer ola)<br />   (princ)<br /> )