自动建图层lsp

liexol

(DEFUN C:TC ()
  (COMMAND "LAYER" "M" "base" "C" "8" "" "")
  (COMMAND "LAYER" "M" "Cp" "C" "214" "" "")
  (COMMAND "LAYER" "M" "d1b" "C" "21" "" "")
  (COMMAND "LAYER" "M" "D01A" "C" "1" "" "")
  (COMMAND "LAYER" "M" "D02A" "C" "5" "" "")
  (COMMAND "LAYER" "M" "D03A" "C" "6" "" "")
  (COMMAND "LAYER" "M" "DD" "C" "150" "" "")
  (COMMAND "LAYER" "M" "S01A" "C" "3" "" "")
  (COMMAND "LAYER" "M" "S1B" "C" "62" "" "")
  (COMMAND "LAYER" "M" "SB" "C" "112" "" "")
  (COMMAND "LAYER" "M" "S02A" "C" "74" "" "")
  (COMMAND "LAYER" "M" "P01A" "C" "2" "" "")
  (COMMAND "LAYER" "M" "P02A" "C" "201" "" "")
  (COMMAND "LAYER" "M" "P03A" "C" "75" "" "")
  (COMMAND "LAYER" "M" "P04A" "C" "30" "" "")
  (COMMAND "LAYER" "M" "DIM" "C" "4" "" "")
  (COMMAND "LAYER" "M" "yb" "C" "171" "" "")
  (COMMAND "LAYER" "M" "zm" "C" "240" "" "")
  (COMMAND "LAYER" "M" "tk" "C" "141" "" "")
  (COMMAND "LAYER" "M" "DB" "C" "202" "" "")
  (COMMAND "LAYER" "M" "p1b" "C" "54" "" "")
  (COMMAND "CLAYER" "0")
)

pleasehelp

最后一行是不是应该是(setvar "clayer" 0)啊？

无痕

用command也可以的

honxj

谢谢分享！

chengzhang

其实用脚本也是非常方便的

Dallas_whu

;;;根据提供的列表建立图层及对应线型
(DEFUN C:NLAYS (/         LAYER_LIST      LAYER_NUM    I
        LAYER         LAYER_NAME      LAYER_COLOR  CHK_LAYER
           )
  ;;图层列表
  (SETQ    LAYER_LIST
     (LIST
       '("图框标签" 8)    '("框架外形" 64)
       '("标高标注" 251)    '("框架标注" 6)
       '("钢筋编号" 3)    '("梁柱钢筋" 1)
       '("图形名称" 7)    '("文字说明" 7)
       '("埋铁布置" 5)    '("填充图案" 91)
       '("辅助线条" 2)    '("材料表格" 7)
       '("详图标注" 3)    '("其它图层" 7)
      )
  )
  (SETQ LAYER_NUM (LENGTH LAYER_LIST))
  (SETQ I 0)
  (REPEAT LAYER_NUM
    (SETQ LAYER (NTH I LAYER_LIST))
    (SETQ LAYER_NAME  (CAR LAYER)
      LAYER_COLOR (CADR LAYER)
    )
    (SETQ CHK_LAYER (TBLSEARCH "LAYER" LAYER_NAME))
    (IF    (= CHK_LAYER NIL)
      (PROGN
    (ENTMAKE (LIST
           '(0 . "LAYER")
           '(100 . "AcDbSymbolTableRecord")
           '(100 . "AcDbLayerTableRecord")
           '(6 . "continuous") ;线型
           (CONS 62 LAYER_COLOR) ;颜色
           '(70 . 0) ;图层状态
           (CONS 2 LAYER_NAME) ;图层名
         )
    )
      )
    )            ;END IF
    (SETQ I (1+ I))
  )            ;END VLAX-FOR

  ;;建立轴线层
  (SETQ CHK_LAYER (TBLSEARCH "LAYER" "轴线"))
  (IF (= CHK_LAYER NIL)
    (PROGN
      (IF (NOT (TBLSEARCH "LTYPE" "CENTER"))
    (ENTMAKE
      '(
        (0 . "LTYPE")
        (100 . "AcDbSymbolTableRecord")
        (100 . "AcDbLinetypeTableRecord")
        (2 . "CENTER")
        (70 . 0)
        (3 . "Center ____ _ ____ _ ____ _ ____ _ ____ _ ____")
        (72 . 65)
        (73 . 4)
        (40 . 2.0)
        (49 . 1.25)
        (74 . 0)
        (49 . -0.25)
        (74 . 0)
        (49 . 0.25)
        (74 . 0)
        (49 . -0.25)
        (74 . 0)
       )
    )
      )

      (EntMake (LIST
         '(0 . "LAYER")
         '(100 . "AcDbSymbolTableRecord")
         '(100 . "AcDbLayerTableRecord")
         '(6 . "CENTER") ;线型
         '(62 . 1) ;颜色
         '(70 . 0) ;图层状态
         (CONS 2 "轴线") ;图层名
           )
      )
    )
  )
  ;;END 轴线

  ;;建立虚线层
  (SETQ CHK_LAYER (TBLSEARCH "LAYER" "虚线"))
  (IF (= CHK_LAYER NIL)
    (PROGN
      (IF (NOT (TBLSEARCH "LTYPE" "HIDDEN"))
    (ENTMAKE
      '(
        (0 . "LTYPE")
        (100 . "AcDbSymbolTableRecord")
        (100 . "AcDbLinetypeTableRecord")
        (2 . "HIDDEN")
        (70 . 0)
        (3 . "Hidden __ __ __ __ __ __ __ __ __ __ __ __ __ _")
        (72 . 65)
        (73 . 2)
        (40 . 0.375)
        (49 . 0.25)
        (74 . 0)
        (49 . -0.125)
        (74 . 0)
       )
    )
      )
      (ENTMAKE (LIST
         '(0 . "LAYER")
         '(100 . "AcDbSymbolTableRecord")
         '(100 . "AcDbLayerTableRecord")
         '(6 . "HIDDEN") ;线型
         '(62 . 8) ;颜色
         '(70 . 0) ;图层状态
         (CONS 2 "虚线") ;图层名
           )
      )
    )
  )
  ;;END 虚线

  (PROMPT
    "\n图层初始化完毕!     BY HB.LEE . 2006-11-03."
  ) ;_ 结束PROMPT
  (PRINC)
)            ;END DEFUN

tcsl9621

你这就是脚本，我用LISP内部命令。

;;;============
;;;= 设置图层 =
;;;============

.(defun addtranslayer (/      styleobj1   layerobj1
        layerobj2     layerobj3   layerobj4
        layerobj5     layerobj6   layerobj7
        layerobj8     layerobj9   layerobj10
       )
  (vl-catch-all-apply
    'vla-load
    (list p2c::linetypes
   "center"
   "acadiso.lin"
    )
  )
  (vl-catch-all-apply
    'vla-load
    (list p2c::linetypes
   "DASHED"
   "acadiso.lin"
    )
  )
  (setq styleobj1 (vla-add p2c::textstyles "GB"))
  (vla-put-fontfile styleobj1 "gbenor.shx")
  (vla-put-bigfontfile styleobj1 "gbcbig.shx")
  (setq layerobj1  (vla-add p2c::layersobj "KERFLEFT")
 layerobj2  (vla-add p2c::layersobj "KERFRIGHT")
 layerobj3  (vla-add p2c::layersobj "KERFOFF")
 layerobj4  (vla-add p2c::layersobj "MARKING")
 layerobj5  (vla-add p2c::layersobj "PLATE")
 layerobj6  (vla-add p2c::layersobj "ZSQ")
 layerobj7  (vla-add p2c::layersobj "CENTER")
 layerobj8  (vla-add p2c::layersobj "DASHED")
;;;
 layerobj9  (vla-add p2c::layersobj "INSIDE")
 layerobj10 (vla-add p2c::layersobj "OUTSIDE")
  )
;;;KERFLEFT
  (vla-put-color layerobj1 acred)
  (vla-put-lineweight layerobj1 aclnwt025)
  (vla-put-linetype layerobj1 "continuous")
;;;KERFRIGHT
  (vla-put-color layerobj2 acred)
  (vla-put-lineweight layerobj2 aclnwt025)
  (vla-put-linetype layerobj2 "continuous")
;;;KERFNO
  (vla-put-color layerobj3 acred)
  (vla-put-lineweight layerobj2 aclnwt025)
  (vla-put-linetype layerobj3 "continuous")
;;;MARKING
  (vla-put-color layerobj4 accyan)
  (vla-put-lineweight layerobj4 aclnwt025)
  (vla-put-linetype layerobj4 "continuous")
;;LATE
  (vla-put-color layerobj5 acblue)
  (vla-put-lineweight layerobj2 aclnwt030)
  (vla-put-linetype layerobj5 "continuous")
;;;ZSQ
  (vla-put-color layerobj6 acwhite)
  (vla-put-linetype layerobj6 "continuous")
;;;CENTER
  (vla-put-color layerobj7 acred)
  (vla-put-linetype layerobj7 "CENTER")
;;;DASHED
  (vla-put-color layerobj8 acgreen)
  (vla-put-linetype layerobj8 "DASHED")
;;;INSIDE
  (vla-put-color layerobj9 acgreen)
  (vla-put-lineweight layerobj9 aclnwt025)
  (vla-put-linetype layerobj9 "continuous")
;;;OUTSIDE
  (vla-put-color layerobj10 acred)
  (vla-put-lineweight layerobj10 aclnwt025)
  (vla-put-linetype layerobj10 "continuous")
;;;END
  (princ)
)

野狼谷/〈M〉

忙了一下午，才看到这还有现成的

林霄云

批量生成图层用mapcar和lambda命令，语句可以简练很多。示例setup_layers

2. (defun setup_Layers()
   
3. (mapcar '(lambda(layname laycolor linetype linewidth)
   
4. 
   
5. (command "layer"   "m"             layname
   
6.      "c"        laycolor          layname
   
7.      "l"           linetype           layname
   
8.      "lw"          linewidth      layname
   
9.      ""
   
10.     )
    
11.      (princ layname)
    
12.   );lambda
    
13.   '("G-AXIS（主轴线）""G-AXIS_TEXT（轴线号）""G-LABEL（引线）""G-SLAB-HATCH（板填充）""G-STAIR（楼梯）"
    
14. )
    
15.   '("9""255""3""11""2"
    
16. )
    
17.   '("_AXIS100""CONTINUOUS""CONTINUOUS""CONTINUOUS""CONTINUOUS"
    
18. )
    
19.   '("0.13""0.3""0.13""0.13""0.13"
    
20. )
    
21.   );mapcar
    
22.   (setvar "clayer" "0"); 当年图层置为“0”
    
23.   );defun
    

(defun setup_Layers()<br /> (mapcar '(lambda(layname laycolor linetype linewidth)<br /> <br /> (command "layer"   "m"             layname<br />      "c"        laycolor          layname<br />      "l"           linetype           layname<br />      "lw"          linewidth      layname<br />      ""<br />     )<br />      (princ layname)<br />   );lambda<br />   '("G-AXIS（主轴线）""G-AXIS_TEXT（轴线号）""G-LABEL（引线）""G-SLAB-HATCH（板填充）""G-STAIR（楼梯）"<br /> )<br />   '("9""255""3""11""2"<br /> )<br />   '("_AXIS100""CONTINUOUS""CONTINUOUS""CONTINUOUS""CONTINUOUS"<br /> )<br />   '("0.13""0.3""0.13""0.13""0.13"<br /> )<br />   );mapcar<br />   (setvar "clayer" "0"); 当年图层置为“0”<br />   );defun<br />

混沌初开

楼主是做冲压模具设计?