wjl1014 发表于 2013-6-9 11:12:19

求助：自动加载pat填充文件（已经解决）。

本帖最后由 wjl1014 于 2013-6-10 20:18 编辑

用lisp编写的pat填充文件，定义完成后如何让cad自动加载pat文件并应用pat文件定义的填充图案?

wjl1014 发表于 2013-6-10 20:19:38


(defun c:tt (/      X      Y      _A      PATNAME INDEX   PATH
      DIMZIN      OX      OY      F      FILENAME
      STR   cmdecho *error*
   )
(defun *error* (s)
    (setvar 'dimzin dimzin)
    (setvar 'cmdecho cmdecho)
    (pronc s)
)
(setq x (getreal "\nX间距:<10.0>"))
(if (null x)
    (setq x 10)
)
(setq y (getreal "\nY间距:<10.0>"))
(if (null y)
    (setq y 10)
)
(setq _a (getangle "\n旋转角度<0>:"))
(if (null _a)
    (setq _a "0")
    (setq _a (angtos _a))
)
(setq patname "TEMPPA_"
index 0
)
(while
    (ssget "x"
    (list '(0 . "hatch") (cons 2 (strcat patname (itoa index))))
    )
   (setq index (1+ index))
)
(setq patname (strcat patname (itoa index)))
(setq path (GETVAR (QUOTE ROAMABLEROOTPREFIX))
dimzin (getvar (quote dimzin))
cmdecho (getvar 'cmdecho)
)
(setvar 'dimzin 8)
(setvar 'cmdecho 0)
(or (eq "\\" (substr path (strlen path)))
      (setq path (strcat path "\\"))
)
(setq path (strcat path "Support\\"))
(setq f (open (setq filename (strcat path patname ".pat")) "w"))
(write-line
    (setq str (strcat "*" patname ",临时填充图案 " patname))
    f
)
(write-line (strcat "0,0,0,0," (rtos x 2 10)) f)
(write-line (strcat "90,0,0,0," (rtos y 2 10)) f)
(close f)
(setq endent (entlast))
(if (>= (atoi (getvar 'acadver)) 17)
    (progn
      (command "_Bhatch" "p" patname "1" _a "o" "d" "l" "n")
      (princ "\n**选择区域点**")
      (while (= 1 (getvar 'cmdactive))
(command pause)
      )
    )
    (progn
      (command "_Bhatch" "p" patname "1" _a)
      (princ "\n**选择区域点**")
      (while (= 1 (getvar 'cmdactive))
(command pause)
      )
    )
)
(setq hatch (entlast))
(if (not (equal endent hatch))
    (command "_explode" hatch)
)
(vl-file-delete filename)
(setvar 'dimzin dimzin)
(setvar 'cmdecho cmdecho)
(princ)
)

wjl1014 发表于 2013-6-10 20:21:02

以上程序由Gu_xl 编写。由于本程序在某个帖子里埋的太深，转至此，请Gu_xl 谅解。

jyzas 发表于 2013-7-10 23:24:40

关键是有源代码，谢谢楼主分享

Excel2119 发表于 2014-6-16 20:16:48

感谢感谢

594826903 发表于 2016-4-13 20:45:37

感谢感谢

bluefcc1 发表于 2018-10-23 21:41:31

感謝樓主分享

不想多说 发表于 2019-4-28 01:21:16

G版是伟大的，是无私的

林小林子 发表于 2019-4-28 08:53:10

G版是伟大的，是无私的

zhangkui9070 发表于 2020-8-23 11:08:09

G版无私
页: [1] 2
查看完整版本: 求助：自动加载pat填充文件（已经解决）。