下面是一个填充图案的程序，我想把填充后的图案自动放到指定的图层内，图层名可以修改

李青松

下面是一个填充图案的程序，我想把填充后的图案自动放到指定的图层内，图层名可以修改
，我想1个命令完成两个动作
(defun c:6y() (command "-BHATCH"  "p" "ansi31" "3" "0"))

自贡黄明儒

(defun c:6y()
(setq my (getvar "clayer"));当前层
(setvar "clayer" "1")
(command "-BHATCH"  "p" "ansi31" "3" "0")
(setvar "clayer" my)
(PRINC)
)

李青松

看不懂，麻烦给1个完整的程序.        重复1下比如：我的当前层是0我想把填充的图案自动放到图层1

李青松

你的程序的功能同我附上的程序的功能是一样的并没有什么区别，
写程序的时候可以先把当前图层0改成图层1，然后再填充，填充完后再把图层改成0这样就是拐了1下弯，思路可以是这样，哪个高手改1下

coolpoom

(defun c:6y(/ ss)
  (setq ss(getstring "\n请输入指定图层:"))
  (command "layer" "m" ss "")
  (command "-BHATCH"  "p" "ansi31" "3" "0" pause)
  (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
  (setvar "clayer" "0")
  (princ)
  )

669423907

G板的也有源码啊！
;自动转层 SunSpring http://bbs.mjtd.com/thread-86804-1-1.html
(defun xlr-autolayer ()
  ;; 图层初始化列表 内容：commands layers color linetype plottable
  (setq *doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *lays (vla-get-layers *doc))
  (setq  *laylst
    (list
          (list "dimlinear" "7标注" 3 "continuous" T)    ;线性
          (list "dimdiameter" "7标注" 3 "continuous" T)  ;直径
          (list "dimradius" "7标注" 3 "continuous" T)    ;半径
          (list "dimcontinue" "7标注" 3 "continuous" T)  ;连续
          (list "dimbaseline" "7标注" 3 "continuous" T)  ;基准
          (list "dimangular" "7标注" 3 "continuous" T)   ;角度
          (list "dimaligned" "7标注" 3 "continuous" T)   ;对齐
          (list "qleader" "7标注" 3 "continuous" T)      ;引线
          (list "dimordinate" "7标注" 3 "continuous" T)  ;坐标标注
          (list "qdim" "7标注" 3 "continuous" T)         ;快速标注
          (list "tolerance" "7标注" 3 "continuous" T)    ;形位公差标注
          (list "dtext" "9文字" 3 "continuous" T)
          (list "mtext" "9文字" 3 "continuous" T)
          (list "xline" "6不打印" 44 "continuous" T)
          (list "text" "9文字" 253 "continuous" T)
          (list "bhatch" "填充" 11 "continuous" T)
          (list "hatch" "填充" 11 "continuous" T)
          (list "dimcenter" "3中心线" 1 "continuous" T)   ;圆心标记
         ;(list "POINT" "点" 4 "continuous" T)
         ;(list "LINE" "0" NIL "continuous" T)
         ;(list "XREF" "引用" 7 "continuous" T)
         ;(list "pline" "多义线" 2 "center" T)
    )
  )
  (setq OldLayer nil)
  (setq *cmdlst (mapcar 'strcase (mapcar 'car *laylst)))
  (mapcar '(lambda (x) (vlr-command-reactor nil x))
    (list  '((:vlr-commandWillStart . xlr-start))
    '((:vlr-commandEnded . xlr-end))
    '((:vlr-commandCancelled . xlr-cancel))
    )
  )
  (vlr-editor-reactor nil '((:vlr-commandwillstart . xlr-edit)))
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit  (call callback / n)
  (foreach n *laylst
    (if  (= (strcase (car callback)) (strcase (car n)))
      (apply 'xsetlays (cdr n))
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startinfo / n)
  (foreach n *laylst
    (if (= (strcase (car xlr-startinfo)) (strcase (car n)))  
      (apply 'xsetlays (cdr n))
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endinfo / cmd)
  (setq cmd (car xlr-endinfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
      (progn
        (setvar "clayer" oldlayer)
        (setq oldlayer nil)
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelinfo / cmd)
  (setq cmd (car xlr-cancelinfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
      (progn
        (setvar "clayer" oldlayer)
        (setq oldlayer nil)
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xsetlays  (lay-nam color ltype plotk / layobj ltypesobj)
  (defun layeron (layername / layerdata)
    (setq layerdata (entget (tblobjname "LAYER" layername)))
    (if (< (cdr (assoc 62 layerdata)) 0)
      (progn
        (setq layerdata (subst
                          (cons 62 (- 0 (cdr (assoc 62 layerdata))))
                          (assoc 62 layerdata)
                          layerdata
                        )
        )
        (entmod layerdata)
      )
    )
  )
  (if (tblobjname "layer" lay-nam)
    (progn
      (if (/= (strcase (getvar "clayer")) (strcase lay-nam))
        (setq oldlayer (getvar "clayer"))
        (progn
          (if (= oldlayer nil)
            (setq oldlayer lay-nam)
          )
        )
      )
      (layeron lay-nam)
      (setvar "clayer" lay-nam)
    )
    (progn
      (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list *lays lay-nam)))
      (setq layobj (vla-item *lays lay-nam))
      (if (not (tblobjname "ltype" ltype)) ;添加线型.
        (progn
          (setq ltypesobj (vla-get-linetypes *doc))
          (vla-load ltypesobj ltype (findfile "acad.lin"))  ;>>>　要加强，在多个*.lin寻找
          (vlax-release-object ltypesobj)
        )
      )
      (vla-put-layeron layobj :vlax-true)
      (vla-put-lock layobj :vlax-false)
      (if (= (strcase (getvar "clayer")) (command "layer" "on" "" "")(strcase lay-nam)) ;解冻.
        (vla-put-freeze layobj :vlax-false)
      )
      (vla-put-color layobj color)
      (vla-put-linetype layobj LTYPE)
      (vla-put-plottable layobj (if plotk :vlax-true :vlax-false))
    )
  )
)
;(xlr-autolayer)        ;加载启动!

李青松

这个程序想改下，不需要输入指定图层，就是所放置的图层弄成自动转到图层1，不要去手动输入了(当前图层是0)所要放置的图层在程序里面可以修改

(defun c:6y(/ ss)
  (setq ss(getstring "\n请输入指定图层:"))
  (command "layer" "m" ss "")
  (command "-BHATCH"  "p" "ansi31" "3" "0" pause)
  (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
  (setvar "clayer" "0")
  (princ)

xyp1964

2. 
   
3. (defun c:tt ()
   
4.   (if (= (tblsearch "layer" "1") nil)
   
5.     (Command "-layer" "m" "1" "c" 1 "" "")
   
6.     (Command "-layer" "t" "1" "")
   
7.   )
   
8.   (setvar "clayer" "1")
   
9.   (princ "\n选择区域点: ")
   
10.   (command "-BHATCH" "p" "ansi31" "3" "0" pause)
    
11.   (while (> (getvar "CMDACTIVE") 0)
    
12.     (command PAUSE)
    
13.     (princ "\n选择区域点<回车完成>: ")
    
14.   )
    
15.   (setvar "clayer" "0")
    
16.   (princ)
    
17. )
    

<br /> (defun c:tt ()<br />   (if (= (tblsearch "layer" "1") nil)<br />     (Command "-layer" "m" "1" "c" 1 "" "")<br />     (Command "-layer" "t" "1" "")<br />   )<br />   (setvar "clayer" "1")<br />   (princ "\n选择区域点: ")<br />   (command "-BHATCH" "p" "ansi31" "3" "0" pause)<br />   (while (> (getvar "CMDACTIVE") 0)<br />     (command PAUSE)<br />     (princ "\n选择区域点<回车完成>: ")<br />   )<br />   (setvar "clayer" "0")<br />   (princ)<br /> )<br />

李青松

xyp1964的程序非常好，赞!!!!

1993063

程序必须要加错误处理

2. (defun c:tt (/ *error* p li cm)
   
3.   (defun *error* (x)
   
4.     (command "undo" "e")
   
5.     (setvar 'clayer li)
   
6.     (setvar 'cmdecho cm)
   
7.     (princ)
   
8.   )
   
9.   (setq        li (getvar 'clayer)
   
10.         cm (getvar 'cmdecho)
    
11.   )
    
12.   (setvar 'cmdecho 0)
    
13.   (command "undo" "be")
    
14.   (Command "-layer" "m" "1" "c" 1 "" "")
    
15.   (setvar "clayer" "1")
    
16.   (setq p (getpoint "\n →请点选:"))
    
17.   (while p
    
18.     (Command ".bhatch" "p" "" "" "" p "")
    
19.      (setq p (getpoint "\r →请点选:"))
    
20.   )
    
21.   (*error* nil)
    
22. )

(defun c:tt (/ *error* p li cm)<br />   (defun *error* (x)<br />     (command "undo" "e")<br />     (setvar 'clayer li)<br />     (setvar 'cmdecho cm)<br />     (princ)<br />   )<br />   (setq        li (getvar 'clayer)<br />         cm (getvar 'cmdecho)<br />   )<br />   (setvar 'cmdecho 0)<br />   (command "undo" "be")<br />   (Command "-layer" "m" "1" "c" 1 "" "")<br />   (setvar "clayer" "1")<br />   (setq p (getpoint "\n →请点选:"))<br />   (while p<br />     (Command ".bhatch" "p" "" "" "" p "")<br />      (setq p (getpoint "\r →请点选:"))<br />   )<br />   (*error* nil)<br /> )