关于图案填充原点位置的帮助

3dwannab · 发表于 2022-7-5 16:33:40

只有两个问题：

1.当我在默认getkword上点击return时，它无法正确运行。

2.当我选择除拾取图案填充位置之外的任何内容时，它将输出到已选择的每个图案填充实体的命令行。我该怎么摆脱它呢。osmode为0。

[use current origin/Set new origin/Default to boundary extents] <Use current origin>:
[bottom Left/bottom Right/top rIght/top lEft/Center] <bottom Left>:] <bottom Left>:

copy

;;-----------------=={ Hatch_Origin_Location.lsp }==--------------------;;
;;  Author: 3dwannab, 2017
;;----------------------------------------------------------------------;;
;;  Version 0.1    -    18-03-2017
;;----------------------------------------------------------------------;;
;;  Hatch Location Options:
;;  BottomLeft/BottomRight/TopRight/TopLeft/Center/Pick
;;----------------------------------------------------------------------;;
(defun c:HOL nil (c:Hatch_Origin_Location))
(defun c:Hatch_Origin_Location ( / *error* os cmde pt ss ent data ans)
(defun *error* (errmsg)
        (and acDoc (vla-EndUndoMark acDoc))
        (and errmsg
                (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
                (princ (strcat "\n<< Error: " errmsg " >>"))
                )
        (setvar 'cmdecho cmde)
        (setvar 'osmode os)
        (princ)
        )
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
(setq os (getvar "osmode"))
(setq cmde (getvar "cmdecho"))
(initget "BottomLeft BottomRight TopRight TopLeft Center Pick")
(setq ans (getkword "\nChoose Hatch Origin Location ? [bottomLeft/BottomRight/TopRight/TopLeft/Center/Pick] <Pick>: "))
(cond
        (
                (= "Pick" ans)
                (sssetfirst)
                (and (setq ent (entsel "\n Select Hatch: "))
                        (setq pt (getpoint "\n New Hatch Origin:"))
                        (command "._HatchEdit" ent "O" "S" pt "N")
                        )
                )
        )
(cond
        (
                (/= "Pick" ans)
                (if        (setq ss (ssget "_:L" '((0 . "HATCH")))
                        )
                (repeat (setq i (sslength ss))
                        (setq ent (ssname ss (setq i (1- i)))
                                data (entget ent)
                                )
                        (progn
                                (cond
                                        (
                                                (= "BottomLeft" ans)
                                                (command "._HatchEdit" ent "O" "D" "L" "N")(princ)
                                                )
                                        (
                                                (= "BottomRight" ans)
                                                (command "._HatchEdit" ent "O" "D" "R" "N")(princ)
                                                )
                                        (
                                                (= "TopRight" ans)
                                                (command "._HatchEdit" ent "O" "D" "I" "N")(princ)
                                                )
                                        (
                                                (= "TopLeft" ans)
                                                (command "._HatchEdit" ent "O" "D" "E" "N")(princ)
                                                )
                                        (
                                                (= "Center" ans)
                                                (command "._HatchEdit" ent "O" "D" "C" "N")(princ)
                                                )
                                        )
                                )
                        )
                )
                )
        )
(*error* nil)
(princ)
)
(vl-load-com)
(princ
(strcat
        "\n:: Hatch_Origin_Location.lsp | Version 0.1 | \\U+00A9 3dwannab " (menucmd "m=$(edtime,0,yyyy)") " ::"
        "\n:: Type "HOL" or "Hatch_Origin_Location" to Run ::"
        )
)
(princ)

danellis · 发表于 2022-7-5 17:14:19

我可能没有完全遵循您的逻辑，但我不认为有任何东西会告诉程序默认为“pick”提示中的指示器仅供用户使用。基本上，ANS的最终COND值为零。

dJE

3dwannab · 发表于 2022-7-5 17:58:06

有那么一点要做。通过将变量设置为“Pick”，使用：

copy

(if (not ans) (setq ans "Pick"))

你能告诉我为什么即使程序中的cmdecho设置为0，它也会输出到cmd吗？

copy

(command-s "._HatchEdit" pause "O" "D" "L" "N")

全新代码：

copy

;;-----------------=={ Hatch_Origin_Location.lsp }==--------------------;;
;;  Author: 3dwannab, 2017
;;----------------------------------------------------------------------;;
;;  Version 0.1    -    18-03-2017
;;----------------------------------------------------------------------;;
;;  Hatch Location Options:
;;  BottomLeft/BottomRight/TopRight/TopLeft/Center/Pick
;;----------------------------------------------------------------------;;
(defun c:HOL nil (c:Hatch_Origin_Location))
(defun c:Hatch_Origin_Location ( / *error* os cmde mutt pt ss ent data ans)
(defun *error* (errmsg)
        (and acDoc (vla-EndUndoMark acDoc))
        (and errmsg
                (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
                (princ (strcat "\n<< Error: " errmsg " >>"))
                )
        (setvar 'cmdecho cmde)
        (setvar 'osmode os)
        (setvar 'nomutt mutt)
        (princ)
        )
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
(setq os (getvar "osmode"))
(setq cmde (getvar "cmdecho"))
(setq ex (getvar "expert"))
(setq mutt (getvar "nomutt"))
(progn
        (setvar 'cmdecho 0)
        (setvar 'osmode 0)
        (setvar 'nomutt 1)
        (initget "bottomLeft bottomRight toprIght toplEft Center Pick")
        (setq ans (getkword "\nX Brick Size (Standard=112.5 Joint=10)? [bottom Left/bottom Right/top rIght/top lEft/Center/Pick] <Pick>: "))
        (if (not ans) (setq ans "Pick"))
        (cond
                ((= "Pick" ans)
                        (sssetfirst)
                        (and (setq ent (entsel "\n Select Hatch: "))
                                (setq pt (getpoint "\n New Hatch Origin:"))
                                (command "._HatchEdit" ent "O" "S" pt "N")
                                )
                        )
                )
        (cond
                ((/= "Pick" ans)
                        (if        (setq ss (ssget "_:L" '((0 . "HATCH")))
                                )
                        (repeat (setq i (sslength ss))
                                (setq ent (ssname ss (setq i (1- i)))
                                        data (entget ent)
                                        )
                                (cond
                                        ((=  "bottomLeft" ans)
                                                (command-s "._HatchEdit" ent "O" "D" "L" "N")(princ)
                                                )
                                        ((= "bottomRight" ans)
                                                (command-s "._HatchEdit" ent "O" "D" "R" "N")(princ)
                                                )
                                        ((= "toprIght" ans)
                                                (command-s "._HatchEdit" ent "O" "D" "I" "N")(princ)
                                                )
                                        ((= "toplEft" ans)
                                                (command-s "._HatchEdit" ent "O" "D" "E" "N")(princ)
                                                )
                                        ((= "Center" ans)
                                                (command-s "._HatchEdit" ent "O" "D" "C" "N")(princ)
                                                )
                                        )
                                )
                        )
                        )
                )
        T
        )
(*error* nil)
(princ)
)
(vl-load-com)
(princ
(strcat
        "\n:: Hatch_Origin_Location.lsp | Version 0.1 | \\U+00A9 3dwannab " (menucmd "m=$(edtime,0,yyyy)") " ::"
        "\n:: Type "HOL" or "Hatch_Origin_Location" to Run ::"
        )
)
(princ)

[编程交流] 关于图案填充原点位置的帮助

发表回复

精选推荐