ucuc2003 发表于 2015-7-10 11:06:03

edata 发表于 2015-7-9 16:44 static/image/common/back.gif


我电脑只装了低版本07-08，我先试一试 OSNAPHATCH

lingduwx 发表于 2015-7-10 11:08:11

lingduwx 发表于 2015-7-9 19:34 static/image/common/back.gif
谢谢，真是解决了俺的一个大难题啊，呵呵

还要麻烦大哥指点一下，标题前面那个红色的（未解决）三个字俺不知道在哪儿取消啊，谢谢了

ucuc2003 发表于 2015-7-10 11:44:56

右上方向有个黄色的按钮：已解决

ucuc2003 发表于 2015-7-10 13:27:48

ucuc2003 发表于 2015-7-10 11:06 static/image/common/back.gif
我电脑只装了低版本07-08，我先试一试 OSNAPHATCH

嗯，已解决，谢谢

ucuc2003 发表于 2015-7-11 14:00:00

本帖最后由 ucuc2003 于 2015-7-11 15:11 编辑


;;;;;改变填充基点及角度 by ucuc2003 2012年5月11日
(defun C:TT5 (/ os htcjd o_DIMZIN ss i s1)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq htcjd (getvar "hpang"))
(setq o_DIMZIN (getvar "DIMZIN"))
(princ "改变填充图案的新基点及角度")
(defun *Error* (msg);出错处理
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
       (setvar "osmode" os))
);defun *Error*
(setvar "DIMZIN" 8)
(setvar "osmode" 7167)

(if (= tcjj_old_ang nil) (setq tcjj_old_ang 0))
(princ (strcat "\n指定填充图案的角度值<" (angtos tcjj_old_ang 0 6) ">: "))
(setq tcjj_hatch_ang (getangle))
(if tcjj_hatch_ang (setq tcjj_old_ang tcjj_hatch_ang)(setq tcjj_hatch_ang tcjj_old_ang))
(setvar "DIMZIN" o_DIMZIN)

(setq pt (getpoint "\n指定填充图案的新基点 <当前原点>:"))
(if (not pt)(setq pt '(0. 0. 0.)))
(setvar "osmode" os)

(while
    (princ "\n请选择填充图案:")
    ;(command "_.undo" "_begin")
    (if (setq ss (ssget '((0 . "hatch"))) i -1)
      (while (setq s1 (ssname ss (setq i (1+ i))))
         (command "hatchedit" s1 "p" "" "" (angtos tcjj_hatch_ang 0 6))
         (setvar "hpang" htcjd)
         (command "-hatchedit" s1 "o" "s" pt "n")
      );while
    )if
    ;(command "undo" "e")
);while
(princ)
);over defun
以前做的一个和这个类似，这个效率有点慢

ucuc2003 发表于 2015-7-11 14:31:10

和edata大侠的程序合体，更高效，使用者自己再简化下，我的代码很啰嗦

本帖最后由 ucuc2003 于 2015-7-11 15:07 编辑

;;;改变填充基点及角度
(defun C:TT6 (/ os htcjd o_DIMZIN ss i s1 obj ang)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq htcjd (getvar "hpang"))
(setq o_DIMZIN (getvar "DIMZIN"))
(princ "改变填充图案的新基点及角度")
(defun *Error* (msg)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
       (setvar "osmode" os))
);defun *Error*
(setvar "DIMZIN" 8)
(setvar "osmode" 7167)
(if (= tcjj_old_ang nil) (setq tcjj_old_ang 0))
(princ (strcat "\n指定填充图案的角度值<" (angtos tcjj_old_ang 0 6) ">: "))
(setq tcjj_hatch_ang (getangle))
(if tcjj_hatch_ang (setq tcjj_old_ang tcjj_hatch_ang)(setq tcjj_hatch_ang tcjj_old_ang))
(setvar "DIMZIN" o_DIMZIN)
(setq pt (getpoint "\n指定填充图案的新基点 <当前原点>:"))
(if (not pt)(setq pt '(0. 0. 0.)))
(setvar "osmode" os)

;(while
    (if (setq ss (ssget ":s" '((0 . "hatch"))) i -1)
      (while (setq s1 (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object s1))
      (setq ang tcjj_hatch_ang)
      (if pt
          (vla-put-Origin
            obj
            (vlax-safearray-fill
            (vlax-make-safearray vlax-vbDouble '(0 . 1))
            (list (car pt) (cadr pt))
            )
          )
      )
      (if ang
          (vla-put-PatternAngle obj ang)
      )
      (vla-update obj)
      );while
    )if
;);while
(princ)
);over defun

ucuc2003 发表于 2015-7-11 15:06:28

本帖最后由 ucuc2003 于 2015-7-11 15:38 编辑

填充角度改成自动记忆的，个人比较喜欢批量的，改成批量的了

lingduwx 发表于 2015-7-11 20:50:34

ucuc2003 发表于 2015-7-11 15:06 static/image/common/back.gif
填充角度改成自动记忆的，个人比较喜欢批量的，改成批量的了

大哥真是厉害啊，这个修改后的简直是太好用了，谢谢了哈

ucuc2003 发表于 2015-7-13 13:16:39

lingduwx 发表于 2015-7-11 20:50 static/image/common/back.gif
大哥真是厉害啊，这个修改后的简直是太好用了，谢谢了哈

这个是必须的

li809 发表于 2017-11-1 15:51:48

对齐填充图案，功能非常好用。谢谢
页: 1 [2] 3
查看完整版本: 请问各位大侠谁有“对齐填充图案”的LSP啊（已解决，谢谢）