帮助：Lisp填充多个c 乐筑天下 - Powered by Discuz! Archiver

vernonlee 发表于 2022-7-5 20:20:06

帮助：Lisp填充多个c

查找hatch lisp以窗口选择多条闭合多段线并立即对其进行图案填充，但会根据当前图案填充设置生成单个图案填充对象。

遇到此代码，但是否无法基于当前图案填充设置

(defun c:mhatch (/ ang do-it doc hatch oname pname scl space ss)
(if (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(progn
(setq scl (getvar "hpscale")
ang (getvar "hpang")
pname (getvar "hpname")
hpassoc (if (= (getvar "hpassoc") 1)
:vlax-true
:vlax-false)
doc (vla-get-activedocument
(vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
)
(vlax-for ent (vla-get-activeselectionset doc)
(setq do-it nil
oname (strcase (vla-get-objectname ent)))
(cond ((vl-string-search "CIRCLE" oname)
(setq do-it t)
)
((and (vl-string-search "LINE" oname)
(eq (vla-get-closed ent) :vlax-true)
)
(setq do-it t)
)
((equal (vlax-curve-getstartpoint ent)
(vlax-curve-getendpoint ent)
1e-6)
(setq do-it t)
)
)
(if do-it
(progn
(setq hatch (vlax-invoke space 'addhatch acHatchObject pname hpassoc))
(vlax-invoke hatch 'appendouterloop (list ent))
(vlax-put hatch 'patternangle ang)
(vlax-put hatch 'patternscale scl)
(vla-evaluate hatch)
)
)
)
)
)
(princ)
)

谢谢

Tharwat 发表于 2022-7-5 20:27:34

你好

我刚刚编写了这个程序，并将其添加到我的Lisp框中

(defun c:Test(/ h _doc ss)
;;; Tharwat 20.01.2014 ;;
(princ "\n Select closed objects to hatch as per current hatch settings ")
(if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
      ss (ssget '((-4 . "<OR")
                     (0 . "CIRCLE,ELLIPSE")
                     (-4 . "<AND")
                     (0 . "LWPOLYLINE")
                     (-4 . "&=")
                     (70 . 1)
                     (-4 . "AND>")
                     (-4 . "OR>"))))

(vlax-for o(vla-get-activeselectionset _doc)
(setq h (vlax-invoke
            (vla-get-block (vla-get-activelayout _doc))
            'addhatch
            acHatchObject
            (getvar "hpname")
            (if (= (getvar "hpassoc") 1)
            :vlax-true
            :vlax-false)))
(vlax-invoke h 'appendouterloop (list o))
(vlax-put h 'patternangle (getvar "hpang"))
(vlax-put h 'patternscale (getvar "hpscale"))
(vla-evaluate h)
)
)
(princ)
)(vl-load-com)

vernonlee 发表于 2022-7-5 20:32:43

嗨，塔尔瓦特。

测试了它&不知何故，它不会遵循非关联的当前设置。

使用LISP进行图案填充时，仍将图案填充为关联。

有什么建议吗？

谢谢

Tharwat 发表于 2022-7-5 20:33:42

使用vlax invoke函数时，关联的参数似乎没有任何意义

试试这个，让我知道

(defun c:Test(/ soc h _doc ss)
;;; Tharwat 20.01.2014 ;;
(princ
"\n Select closed objects to hatch as per current hatch settings ")
(if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
      soc (if (= (getvar "hpassoc") 1)
            :vlax-true
            :vlax-false)
      ss (ssget '((-4 . "<OR")
                     (0 . "CIRCLE,ELLIPSE")
                     (-4 . "<AND")
                     (0 . "LWPOLYLINE")
                     (-4 . "&=")
                     (70 . 1)
                     (-4 . "AND>")
                     (-4 . "OR>"))))
(vlax-for o(vla-get-activeselectionset _doc)
(setq h (vlax-invoke
            (vla-get-block (vla-get-activelayout _doc))
            'addhatch
            acHatchObject
            (getvar "hpname")
            soc))
(vlax-invoke h 'appendouterloop (list o))
(vla-put-AssociativeHatch h soc)
(vlax-put h 'patternangle (getvar 'hpang))
(vlax-put h 'patternscale (getvar 'hpscale))
(vla-evaluate h)
)
)
(princ)
) (vl-load-com)

vernonlee 发表于 2022-7-5 20:39:07

嗨，塔尔瓦特。

我现在工作。

但我意识到一些多段线不是闭合的，而是看起来很近（不知道有这样的事情），正常的hatch命令可以选择。

您能包括那些可以通过普通hatch命令选择的吗？

谢谢

Tharwat 发表于 2022-7-5 20:42:27

你为什么引用每一个回复？只要一个简单的回复就足够了，如果你没有回复到特定的点，请从你的回复中删除这两个程序，以保持线程的表示至少看起来很好。

用你的选择集函数替换我的选择集函数。

如。

(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

仅使用高亮显示的代码。

(setq _doc (vla-get-activedocument (vlax-get-acad-object))
      soc (if (= (getvar "hpassoc") 1)
            :vlax-true
            :vlax-false)
         ss (ssget '((-4 . "<OR")
                     (0 . "CIRCLE,ELLIPSE")
                     (-4 . "<AND")
                     (0 . "LWPOLYLINE")
                     (-4 . "&=")
                     (70 . 1)
                     (-4 . "AND>")
                     (-4 . "OR>")))
)

vernonlee 发表于 2022-7-5 20:47:35

罗杰。将清理我以前的帖子。

代码替换了吗&我在加载lisp时遇到了这个错误

; error: malformed list on input

更换后我的代码是

(defun c:Test(/ soc h _doc ss)
;;; Tharwat 20.01.2014 ;;
(princ
"\n Select closed objects to hatch as per current hatch settings ")
(if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
      soc (if (= (getvar "hpassoc") 1)
            :vlax-true
            :vlax-false)
      (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
)
(vlax-for o(vla-get-activeselectionset _doc)
(setq h (vlax-invoke
            (vla-get-block (vla-get-activelayout _doc))
            'addhatch
            acHatchObject
            (getvar "hpname")
            soc))
(vlax-invoke h 'appendouterloop (list o))
(vla-put-AssociativeHatch h soc)
(vlax-put h 'patternangle (getvar 'hpang))
(vlax-put h 'patternscale (getvar 'hpscale))
(vla-evaluate h)
)
)
(princ)
) (vl-load-com)

Tharwat 发表于 2022-7-5 20:50:30

否，请阅读此修改并将其与您上次的回复进行比较。

(defun c:Test(/ soc h _doc ss)
;;; Tharwat 20.01.2014 ;;
(princ
"\n Select closed objects to hatch as per current hatch settings ")
(if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
      soc(if (= (getvar "hpassoc") 1)
               :vlax-true
               :vlax-false)
      ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))
      )
(vlax-for o(vla-get-activeselectionset _doc)
(setq h (vlax-invoke
            (vla-get-block (vla-get-activelayout _doc))
            'addhatch
            acHatchObject
            (getvar "hpname")
            soc))
(vlax-invoke h 'appendouterloop (list o))
(vla-put-AssociativeHatch h soc)
(vlax-put h 'patternangle (getvar 'hpang))
(vlax-put h 'patternscale (getvar 'hpscale))
(vla-evaluate h)
)
)
(princ)
)(vl-load-com)

vernonlee 发表于 2022-7-5 20:54:41

好啊我想我也做错了什么。明天我回到办公室时，我会比较它们，看看哪里出了问题，并测试代码。然后将反馈。

再次感谢兄弟。

Tharwat 发表于 2022-7-5 20:58:44

祝你好运

页: [1] 2

乐筑天下's Archiver

帮助：Lisp填充多个c