sbwdx 发表于 2019-12-1 13:57:56

修改填充图案基点，想加个出错函数。

正常执行，没有问题，可以先选择，再指定基点，也可以后选择指定基点，执行都没问题，不选对象空格，直接结束，也没问题，就是中途按ESC，退出，有点麻烦，哪位老师，能帮我加个出错函数吗？中途ESC退出后，取消所有操作，退出，下面是我编的简单源码。
(defun c:hd ()
(setvar "CMDECHO" 0)
(setq SS (ssget))
(if (/= ss nil)   
         (command"-hatchedit" SS "o""s"(getpoint "\n指定的填充原点:")"y")
         )
(setvar "CMDECHO" 1)
(princ)
)

taoyi0727 发表于 2019-12-1 13:57:57

(defun c:hd (/ *error* *error*_bak cmdecho ss t-error)
        (defun T-error (msg)
                (setq *error* *error*_bak)
                (setq pt (Vla-get-Origin (vlax-ename->vla-object (ssname ss 0 ))))
                (setq pt (vlax-safearray->list (vlax-variant-value pt)))
                (vlax-invoke-method
                        (vlax-get (vlax-get-acad-object) 'activedocument)
                        'sendcommand
                        (strcat "(command '" (vl-prin1-to-string pt) "\"Y\") ")
                )
                (princ)
        )
        (if (setq ss (ssget ":E:S" '((0 . "HATCH"))))   
                (progn
                        (setq *error*_bak *error*)
                        (setq *error* T-error)
                        (setq CMDECHO (getvar "CMDECHO"))
                        (setvar "CMDECHO" 0)
                        (command "-hatchedit" ss "o" "s" (getpoint "\n指定的填充原点:") "y")
                        (setvar "CMDECHO" CMDECHO)
                )
        )
        (princ)
)
这个凑合用能

taoyi0727 发表于 2019-12-1 14:20:46

本帖最后由 taoyi0727 于 2019-12-1 14:25 编辑

(defun c:hd (/ cmdecho ss)
        (if (setq SS (ssget '((0 . "HATCH"))))   
                (progn
                        (setq CMDECHO (getvar "CMDECHO"))
                        (setvar "CMDECHO" 0)
                        (command "-hatchedit" SS "o" "s" (getpoint "\n指定的填充原点:") "y")
                        (setvar "CMDECHO" CMDECHO)
                )
        )
        (princ)
)
不用加错误函数吧

sbwdx 发表于 2019-12-1 14:26:43

taoyi0727 发表于 2019-12-1 14:20
(defun c:hd (/ cmdecho ss)
        (if (setq SS (ssget '((0 . "HATCH"))))   
                (progn


]好吧，老师，我感觉差别不大

taoyi0727 发表于 2019-12-1 16:29:09

(defun c:hd (/ e name pt pt-new ss)
        (if (setq SS (ssget '((0 . "HATCH"))))
                        (while (setq name (ssname ss 0))
                                (setq e (vlax-make-safearray vlax-vbDouble '(0 . 1)))
                                (setq pt (getpoint))
                                (setq pt-new (vlax-make-variant (vlax-safearray-fill e (list (car pt) (cadr pt)))))
                                (Vla-put-Origin (vlax-ename->vla-object name) pt-new)
                                ;(vla-Update obj)
                                (entupd name)
                                (ssdel name ss)
                        )
        )
        (princ)
)
上面的能改原点位置,但是图像始终就是不变,搞不定了
只能帮你到这里了

taoyi0727 发表于 2019-12-1 16:31:18

没有想明白,实际原点的值是改变了的,但图像就是不变,待高手指点

sbwdx 发表于 2019-12-1 16:37:18

taoyi0727 发表于 2019-12-1 16:31
没有想明白,实际原点的值是改变了的,但图像就是不变,待高手指点

确实哈，图案没有变，我还是用原来的吧

KO你 发表于 2019-12-1 16:53:55

(defun c:hd () (command"-hatchedit"(ssget)"o""s"(getpoint "\n指定的原点:")"y"))

sbwdx 发表于 2019-12-2 10:43:57

taoyi0727 发表于 2019-12-1 17:27
(defun c:hd (/ *error* *error*_bak cmdecho ss t-error)
        (defun T-error (msg)
                (setq *error* *erro ...

谢谢老师，这个比我那个好用哈！基本就是我要的那个效果了！

594826903 发表于 2019-12-10 17:40:39

感谢感谢！
页: [1]
查看完整版本: 修改填充图案基点，想加个出错函数。