下面是一个填充图案的程序，我想把填充后的图案自动放到指定的图层内，图层名可以修改

李青松

1993063的程序在填充的时候出现捕捉，需要去掉，请改1下

李青松

还有1993063的程序在改填充类型的时候在程序里的哪个地方改，请用红色标出

depgfdepgf

谢谢分享，支持

鱼与熊掌

收藏掉。···～～～～～～～～～～～～～～～～～

小毛草

我亦增加一个自已在;;预设常用填充V1.2版本上改进的版本，基本上达到我自已想到的要求！真的比较好用！版权所有为原作者所有，本人只不过在上面改进了自已的想法！望原作者见谅！


(defun c:H (/ opt oldcolor *error*)
(defun *error* (msg)
(setvar "cecolor""bylayer") ;_ 恢复颜色随层；
(princ "错误信息: ")
(princ msg)      ;_ 打印错误信息
(princ)         
)

(setvar "measurement" 0)     ; 设置公制单位
(setvar "cmdecho" 0)         ; 关闭命令响应
(setvar "hpassoc" 0)          ;设置填充时不关联
(setq mylayer (getvar "clayer"))    ;保存当前层
(setq oldcolor (getvar "cecolor"))   ;保存原有颜色
(if *num_HType*
  (setq num_HType (getint (strcat "\n选择填充样式  ①砖墙 ②混凝土 ③素混凝土 ④玻璃 ⑤地砖600 ⑥地砖300 ⑦大理石 ⑧木纹 ⑨拉丝间距50 ⑩实体填充: <" (rtos *num_HType* 2 0) ">")))
  (setq num_HType (getint "\n选择填充样式  ①砖墙 ②混凝土 ③素混凝土 ④玻璃 ⑤地砖600 ⑥地砖300 ⑦大理石 ⑧木纹 ⑨拉丝间距50 ⑩实体填充 : " ))
)
(if (not num_HType)
  (setq num_HType *num_HType*)
  (setq *num_HType* num_HType)
)
(setq opt num_HType)

(if (< 0 opt 18) (eval (read(strcat "(tianchong" (itoa opt) ")"))));根据选项参数执行填充样式

(if (setq ss (ssget))
  (command "bhatch" "s" ss "" "") ;如果选择集不为空，则执行对象填充
  (progn  ;如果选择集为空，则执行点选命令
  (prompt "\n请拾取填充内部点：\n")
  (command "bhatch" pause)
  (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
))

(command "color" oldcolor)   ;设置为原有颜色
;;(setvar "cecolor" "bylayer")  ;设置颜色随层

;;(setvar "color" "251")  ;设置颜色随层
(setvar "clayer" mylayer)
(princ)
)
(defun tianchong1 ()
(prompt "\n当前样式: ①砖墙 比例500\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "-bhatch" "p" "AN31B" "500" "0" "")
)
(defun tianchong2 ()
(prompt "\n当前样式: ②混凝土\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "AN31C" "500" "0" "")
)
(defun tianchong3 ()
(prompt "\n当前样式: ③素混凝土\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "AN33C" "200" "0" "")
)
(defun tianchong4 ()
(prompt "\n当前样式: ④玻璃\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
  (if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "AR-RROOF" "350" "45" "")
)
(defun tianchong5 ()
(prompt "\n当前样式: ⑤600x600地砖\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "251")
(command "bhatch" "p" "U" "0" "600" "Y" "")
)
(defun tianchong6 ()
(prompt "\n当前样式: ⑥300x300地砖\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "251")
(command "bhatch" "p" "U" "0" "300" "Y" "")
)
(defun tianchong7 ()
(prompt "\n当前样式: ⑦大理石\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "大理石" "100" "0" "")
)
(defun tianchong8 ()
(prompt "\n当前样式: ⑧木纹\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "木纹02" "30" "0" "")
)
(defun tianchong9 ()
(prompt "\n当前样式: ⑨拉丝间距50\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "U" "0" "50" "N" "")
)
(defun tianchong10 ()
(prompt "\n当前样式:  ⑩实体填充\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(if (= (tblsearch "layer" "PUB_HATCH") nil)
    (Command "-layer" "m" "PUB_HATCH" "c" 251 "" "")
    (Command "-layer" "t" "PUB_HATCH" "")
  )
(setvar "clayer" "PUB_HATCH")
(command "bhatch" "p" "SOLID" "0" "0" "")
)

hooboxu

改进了什么啊^_^^_^！

＿Levin

xyp1964 发表于 2013-10-29 18:22

高手，填充完成之后可以不要在0图层吗? 完成填充后可以跳回填充之前的图层吗？

376394482

先看看再说

1993063

李青松 发表于 2013-11-5 21:56
还有1993063的程序在改填充类型的时候在程序里的哪个地方改，请用红色标出

你专发号施令?