填充的图层名

llsheng_73

adc 发表于 2013-11-19 13:31
还是要麻烦你帮忙，现在程序还是不能执行，我已经把完整的贴出来了麻烦帮忙看看

1. (defun SETLAYER(LAY CLR / AcDocument layerObj)
   
2.   (vl-load-com)
   
3.   (setq layerObj(vla-add(vla-get-Layers(setq AcDocument(vla-get-ActiveDocument(vlax-get-acad-object))))LAY))
   
4.   (vla-put-ActiveLayer AcDocument layerObj)
   
5.   (vla-put-Color layerObj CLR)
   
6. )
   
7. 
   
8. 
   
9. (defun SETLAYER_LSP(LAY CLR)
   
10.   (if (=(tblobjname "LAYER" LAY) nil)
    
11.     (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
    
12.        '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))) (setvar "CLAYER" LAY)
    
13.   )

(defun SETLAYER(LAY CLR / AcDocument layerObj)<br />   (vl-load-com)<br />   (setq layerObj(vla-add(vla-get-Layers(setq AcDocument(vla-get-ActiveDocument(vlax-get-acad-object))))LAY))<br />   (vla-put-ActiveLayer AcDocument layerObj)<br />   (vla-put-Color layerObj CLR)<br /> )<br /> <br /> <br /> (defun SETLAYER_LSP(LAY CLR)<br />   (if (=(tblobjname "LAYER" LAY) nil)<br />     (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")<br />        '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))) (setvar "CLAYER" LAY)<br />   )

用上边两个函数中的任何一个都可以，最好别用COMMAND，很多命令会因为版本有点差异

adc

llsheng_73 发表于 2013-11-19 13:45
用上边两个函数中的任何一个都可以，最好别用COMMAND，很多命令会因为版本有点差异

我替换了还是不能执行，是不是这句有问题(and (setq E (ssname SS (setq I (1- I)))LA(strcat(cdr(assoc 8 e))"填充"))

llsheng_73

adc 发表于 2013-11-20 10:44
我替换了还是不能执行，是不是这句有问题(and (setq E (ssname SS (setq I (1- I)))LA(strcat(cdr(assoc  ...

你那个AND起什么作用的？

adc

llsheng_73 发表于 2013-11-20 11:03
你那个AND起什么作用的？

我也不清楚，这个程序不是我写的，删掉也还是不可以，麻烦帮忙看一下吧

llsheng_73

弄了半天你找了个别人的程序！！
首先它原来能运行不？

adc

llsheng_73 发表于 2013-11-24 13:13
弄了半天你找了个别人的程序！！
首先它原来能运行不？

以前可正常运行的

llsheng_73

(defun C:tt (/ old_clayer old-layer HPNAME SETLAYER_LSP)
  (defun SETLAYER_LSP(LAY CLR)
    (if (=(tblobjname "LAYER" LAY) nil)
      (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
                    '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY))))
    (setvar "CLAYER" LAY))
   (vl-load-com)
   (command "undo" "be")
   (setvar "CMDECHO" 0)
;  (setq old_clayer (getvar "clayer"))
;  (setq old-layer (tblsearch "layer" "PUB_HATCH"))
;  (if (null old-layer) (command "-layer" "m" "PUB_HATCH" "c" 252 "" ""))
; (command  "layer"  "t"  "PUB_HATCH"  "")
; (command  "layer"  "on"  "PUB_HATCH"  "")
;  (setvar "clayer" "PUB_HATCH")
   (vla-endundomark
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
   )
   (vla-startundomark
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
   )
   (setq HPNAME (getvar "HPNAME"))
   (setvar "HPNAME" "SOLID")
   (vl-catch-all-apply
     '(lambda (/ E I SS)
        (setq SS (ssget '((0 . "LWPOLYLINE"))))
             (repeat (setq I (sslength SS))
               (SETLAYER_LSP(setq E (ssname SS (setq I (1- I)))
                                  LA(strcat(cdr(assoc 8(entget E)))"填充"))7)
             ;  (command "LAYER" "M"LA "S"LA"")
               (command ".-BHATCH" "S" E "" "")
                    ;;(command "hatch" "solid" E "")
             )
      )
   )
   (setvar "HPNAME" HPNAME)
   (vla-endundomark
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
   )
   (setvar "clayer" old_clayer)
   (command "undo" "e")
   (princ)
)

q3_2006

达到目的的思路就不好，应该随意填充，然后全图填充自动归并到相应层，因为图有可能是从别人那里接手的。不是要多一道处理吗？

llsheng_73

q3_2006 发表于 2013-11-24 13:56
达到目的的思路就不好，应该随意填充，然后全图填充自动归并到相应层，因为图有可能是从别人那里接手的。不 ...

正因为图可能从别人哪里接手，随意填充的话，最后归并更不好找依据了，按说楼主本来的想法是没什么问题的

yzr2002626

程序有时能运行，有时不行。无效果