填充的图层名

adc

下面是一个多段线填充的程序，请问怎样将填充的图层名自分别改为“多段线图层名+填充”？程序功能不改变，同样可以框选和点选。


(defun C:tt (/ old_clayer old-layer HPNAME)
  (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)
       (and (setq SS (ssget '((0 . "LWPOLYLINE"))))
            (repeat (setq I (sslength SS))
              (and (setq E (ssname SS (setq I (1- I))))
                   (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)
)

yangchao2005090

llsheng_73 发表于 2013-11-24 13:54
(defun C:tt (/ old_clayer old-layer HPNAME SETLAYER_LSP)
  (defun SETLAYER_LSP(LAY CLR)
    (if (= ...

好像圆不能填充

wu0146

好像圆不能填充

llsheng_73

(and (setq E (ssname SS (setq I (1- I))))
                    (command ".-BHATCH" "S" E "" "")
                    ;;(command "hatch" "solid" E "")
               )
这里setq语句加上一个变量根据(CDR(assoc 8 E))得到E的图层名。加上“填充”得到新的图层名赋给它,下边在填充前把刚才得到的图层名设为当前图层后再填充

1. (and (setq E (ssname SS (setq I (1- I)))LA(strcat(cdr(assoc 8 e))"填充")) ;;;我是真心没看懂那个AND起什么作用
   
2.                     (command "LAYER" "M"LA "S"LA"")
   
3.                     (command ".-BHATCH" "S" E "" "")
   
4.                     ;;(command "hatch" "solid" E "")
   
5.                )

(and (setq E (ssname SS (setq I (1- I)))LA(strcat(cdr(assoc 8 e))"填充")) ;;;我是真心没看懂那个AND起什么作用<br />                     (command "LAYER" "M"LA "S"LA"")<br />                     (command ".-BHATCH" "S" E "" "")<br />                     ;;(command "hatch" "solid" E "")<br />                )

adc

llsheng_73 发表于 2013-10-31 12:56
(and (setq E (ssname SS (setq I (1- I))))
                    (command ".-BHATCH" "S" E "" "")
    ...

谢谢帮忙，不过好像不行

llsheng_73

adc 发表于 2013-10-31 16:50
谢谢帮忙，不过好像不行

为什么我电脑上能行？

llsheng_73

adc 发表于 2013-10-31 16:50
谢谢帮忙，不过好像不行

不行话那就这样吧，(SETQ 语句不用管它了，
下边COMMAND改改
(command "-LAYER" "N" la)
(setvar "CLAYER" la)

adc

llsheng_73 发表于 2013-10-31 17:11
不行话那就这样吧，(SETQ 语句不用管它了，
下边COMMAND改改
(command "-LAYER" "N" la)

改过也不可以
(defun C:tt (/ old_clayer old-layer HPNAME)
  (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)
       (and (setq SS (ssget '((0 . "LWPOLYLINE"))))
            (repeat (setq I (sslength SS))
              (and (setq E (ssname SS (setq I (1- I)))LA(strcat(cdr(assoc 8 e))"填充"))
                    (command "-LAYER" "N" la)
                     (setvar "CLAYER" 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)
)

adc

自己顶起，继续请教

adc

自己顶起，继续请教

adc

自己顶起，继续请教

adc

llsheng_73 发表于 2013-10-31 17:11
不行话那就这样吧，(SETQ 语句不用管它了，
下边COMMAND改改
(command "-LAYER" "N" la)

还是要麻烦你帮忙，现在程序还是不能执行，我已经把完整的贴出来了麻烦帮忙看看