修改块内填充类型

casd

因为专业要求不同，需要将图块内的dots填充修改层solid类型。求解决方案，最好写成通用函数
xxx（块名， 原填充，新填充）的函数形式。

Free-Lancer

1. (defun Insert:NewPatternName (bn oldPatternName NewPatternName)
   
2.   (vlax-for obj        (vla-item (fy:acblocks)bn )
   
3.     (if        (and (wcmatch (vla-get-objectname obj) "*Hatch")
   
4.              (=        (strcase (vla-get-patternname obj))
   
5.                 (strcase oldPatternName)
   
6.              )
   
7.         )
   
8.       (vla-setpattern
   
9.         obj
   
10.         (vla-get-patterntype obj)
    
11.         NewPatternName
    
12.       )
    
13.     )
    
14.   )
    
15.   (fy:clearcset)
    
16.   (if (ssget "X" (list (cons 2 bn)))
    
17.     (mapcar 'vla-update (fy:cset->objs))
    
18.   )
    
19.   (princ)
    
20. )

(defun Insert:NewPatternName (bn oldPatternName NewPatternName)<br />   (vlax-for obj        (vla-item (fy:acblocks)bn )<br />     (if        (and (wcmatch (vla-get-objectname obj) "*Hatch")<br />              (=        (strcase (vla-get-patternname obj))<br />                 (strcase oldPatternName)<br />              )<br />         )<br />       (vla-setpattern<br />         obj<br />         (vla-get-patterntype obj)<br />         NewPatternName<br />       )<br />     )<br />   )<br />   (fy:clearcset)<br />   (if (ssget "X" (list (cons 2 bn)))<br />     (mapcar 'vla-update (fy:cset->objs))<br />   )<br />   (princ)<br /> )

casd

下载了链接中的lib.vlx 和 app.fas,还是不能执行，还缺什么？

st788796

casd 发表于 2014-3-9 10:19
下载了链接中的lib.vlx 和 app.fas,还是不能执行，还缺什么？

你用的什么版本CAD？也许低版本的setpattern方法还不成熟

Free-Lancer

casd 发表于 2014-3-9 10:19
下载了链接中的lib.vlx 和 app.fas,还是不能执行，还缺什么？

只需要 app.fas 中的几个函数，不清楚你是什么版本

1. (defun c:tt (/ e el )
   
2.   (princ "\nselect Insert .....")
   
3.   (if (and (setq e (nentsel "\nPick Hatch In BlockRef: "))
   
4.            (> (length e) 2)
   
5.            (setq el (entget (car e)))
   
6.            (= (cdr (assoc 0 el)) "HATCH")
   
7.       )
   
8.     (Insert:NewPatternName
   
9.       (cdr (assoc 2 (entget (last (last e)))))
   
10.       (cdr (assoc 2 el))
    
11.       "SOLID"
    
12.     )
    
13.   )
    
14.   (princ)
    
15. )

(defun c:tt (/ e el )<br />   (princ "\nselect Insert .....")<br />   (if (and (setq e (nentsel "\nPick Hatch In BlockRef: "))<br />            (> (length e) 2)<br />            (setq el (entget (car e)))<br />            (= (cdr (assoc 0 el)) "HATCH")<br />       )<br />     (Insert:NewPatternName<br />       (cdr (assoc 2 (entget (last (last e)))))<br />       (cdr (assoc 2 el))<br />       "SOLID"<br />     )<br />   )<br />   (princ)<br /> )

casd

现在好用了，非常棒，非常感谢！

kkt123

;P常用Vlisp库文件;P