请问各位大侠谁有“对齐填充图案”的LSP啊（已解决，谢谢）

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

edata 发表于 2015-7-9 16:44

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

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

lingduwx 发表于 2015-7-9 19:34
谢谢，真是解决了俺的一个大难题啊，呵呵

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

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

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

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

ucuc2003 发表于 2015-7-10 11:06
我电脑只装了低版本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

;;;;;改变填充基点及角度 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

本帖最后由 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

;;;改变填充基点及角度 
(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
填充角度改成自动记忆的，个人比较喜欢批量的，改成批量的了

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

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

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

这个是必须的

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

对齐填充图案，功能非常好用。谢谢

账号		自动登录	找回密码
密码			注册

[已解答] 请问各位大侠谁有“对齐填充图案”的LSP啊（已解决，谢谢）

点评

点评

本帖子中包含更多资源

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

本帖子中包含更多资源