如何在多个p中放置图案填充
海所有我在计算机辅助设计方面比较在行
我的老板给了我一个包含1000个多边形（闭合多段线）的dwg，并希望我独立地填充所有多边形
请帮忙
有lisp可用吗？
如果有，请发邮件至
rajtoms@saudia.com
或在此处发布
任何帮助都将不胜感激 这个Lisp程序可能对你有帮助，这是我一直在使用的。
拾取现有图案填充，然后拾取内部点。
将键盘快捷键“gh”更改为适合您的任意键
;;; The following function will match a hatch based on its properties,
;;; making the new hatch boundary-associative.
;;; (equivalent to the "inherit properties" option
(defun matchhatch (/ intpoint entlayer entcolor pattern entltype hscale hangle)
(setq prev_echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_be")
(setq ent (entsel))
(setq entlist (entget (car ent)))
(if (= (cdr (assoc 0 entlist)) "HATCH")
(progn
(setq intpoint (cadr ent))
(setq entlayer (cdr (assoc 8 entlist)))
(setq entcolor (cdr (assoc 62 entlist)))
(if (= entcolor nil); (bylayer returns nil)
(setq entcolor "bylayer")
)
(setq entltype (cdr (assoc 6 entlist)))
(if (= entltype nil)
(setq entltype "bylayer")
)
(setq pattern (cdr (assoc 2 entlist)))
(setq hscale (cdr (assoc 41 entlist)))
(setq hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))
(setq intpoint T)
(setq prev_osmode (getvar "osmode"))
(setvar "osmode" 0)
(while (/= intpoint nil)
(setq intpoint (getpoint "\nSpecify internal point: "))
(command "_.bhatch" "a" "a" "y" "" "_p" pattern hscale hangle intpoint "")
(command "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
)
(setvar "osmode" prev_osmode)
(graphscr)
)
(princ "\nNo hatch selected.")
)
(command "_.undo" "_end")
(setvar "cmdecho" prev_echo)
(princ)
)
;; main function
(defun c:gh () (matchhatch))
我没有一个可以一次完成所有多边形的，但我可能可以在周末写一个——你需要多久？
那将对我有帮助。
任何时候都可以。总是在寻找有用的代码。
干得好：
(defun c:mhatch (/ ss1 entlayer entcolor pattern entltype hscale hangle)
(setq prev_echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_be")
(gethatch)
(setq ss1 (ssget))
(setq ent-index 0)
(setq update-index 0)
(repeat (sslength ss1)
(setq entname (ssname ss1 ent-index))
(command "_.bhatch" "a" "a" "y" "" "_p" pattern hscale hangle "s" entname "" "")
(command "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
(setq update-index (1+ update-index))
(setq ent-index (1+ ent-index))
); repeat
(princ (strcat "\nIndividually hatched " (itoa update-index) " entity(ies).")); closing msg
(graphscr)
(command "_.undo" "_end")
(setvar "cmdecho" prev_echo)
(princ)
)
;;; Function to obtain hatch information
(defun gethatch ( )
(setq ent (entsel))
(setq entlist (entget (car ent)))
(if (= (cdr (assoc 0 entlist)) "HATCH")
(progn
(setq intpoint (cadr ent))
(setq entlayer (cdr (assoc 8 entlist)))
(setq entcolor (cdr (assoc 62 entlist)))
(if (= entcolor nil); (bylayer returns nil)
(setq entcolor "bylayer")
)
(setq entltype (cdr (assoc 6 entlist)))
(if (= entltype nil)
(setq entltype "bylayer")
)
(setq pattern (cdr (assoc 2 entlist)))
(setq hscale (cdr (assoc 41 entlist)))
(setq hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))
)
(princ "\nNo hatch selected.")
)
(princ)
)
便宜又脏，但效果很好。 确实如此。
非常感谢。 非常感谢大家
我的问题解决了
cad导师。。。RRRRR OCKS。。。。。 此lisp在Autocad 2017中不工作，将显示以下错误：
错误：错误的参数类型：numberp:nil
这里需要你的帮助，提前谢谢！ Post#4中的LISP在AutoCAD 2018中运行良好。
你试过不同的绘图或图案填充吗？张贴一张这样做的图纸，也许有人能弄明白。还有，你对代码做了什么吗？尝试发布您正在使用的代码。请阅读代码发布指南，并将代码包含在代码标签中。
Your Code Here=
Your Code Here 做了一些小的修改，也许这对你来说会更好
; http://www.cadtutor.net/forum/showthread.php?32917-How-to-put-hatch-in-multiple-polygons..
(defun c:mhatch (/ prev_echo ent intpoint entlist entlayer entcolor pattern entltype hscale hangle intpoint ss1)
(setq prev_echo (getvar "cmdecho"))(setvar "cmdecho" 0)(command "_.undo" "_be")
(gethatch)
(if ent
(progn
(princ "\nSelect objects : ")
(if (setq ss1 (ssget))
(progn
(setq ent-index 0 update-index 0)
(repeat (sslength ss1)
(setq entname (ssname ss1 ent-index))
(command-s "_.hatch" "a" "a" "y" "" "_p" pattern hscale hangle "s" entname "" "")
(command-s "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
(setq update-index (1+ update-index) ent-index (1+ ent-index)))
)
(princ "\nNo objects were selected")
)
)
(princ "\nNo (valid) hatch object was selected - nothing was hatched")
)
(if (and update-index (> update-index 0))
(princ (strcat "\nIndividually hatched " (itoa update-index) " entity(ies).")))
(graphscr)(command "_.undo" "_end")(setvar "cmdecho" prev_echo)
(princ)
)
;;; Function to obtain hatch information
(defun gethatch ()
(princ "\nSelect hatch : ")
(if (and (setq ent (entsel)) (setq entlist (entget (car ent))) (= (cdr (assoc 0 entlist)) "HATCH"))
(progn
(setq intpoint (cadr ent) entlayer (cdr (assoc 8 entlist)) pattern (cdr (assoc 2 entlist))
hscale (cdr (assoc 41 entlist)) hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))
(if (= (setq entcolor (cdr (assoc 62 entlist))) nil) (setq entcolor "bylayer"))
(if (= (setq entltype (cdr (assoc 6 entlist))) nil) (setq entltype "bylayer"))
)
(progn (princ "\nNo hatch selected.") (setq ent nil))
)
)
FWIW，bhatch命令具有按钮继承属性并切换“创建单独的图案填充”，并且该命令似乎无法使用用户图案填充。
gr.Rlx 你应该能够做到这一点，没有任何代码。
将HPSEPARATE设置为1。然后使用hatch命令。
页:
[1]
2