自动建图层lsp

liexol 发表于 2006-9-24 17:26:00

(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 发表于 2006-9-26 22:53:00

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

无痕发表于 2006-9-27 23:14:00

用command也可以的

honxj 发表于 2006-11-4 21:56:00

谢谢分享！

chengzhang 发表于 2006-11-5 18:17:00

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

Dallas_whu 发表于 2006-11-5 20:12:00

;;;根据提供的列表建立图层及对应线型 (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 发表于 2006-11-7 11:35:00

你这就是脚本，我用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") ;;;PLATE   (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〉 发表于 2012-9-2 18:06:39

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

林霄云 发表于 2013-12-28 17:21:07

本帖最后由林霄云于 2013-12-28 17:22 编辑

批量生成图层用mapcar和lambda命令，语句可以简练很多。示例setup_layers(defun setup_Layers()
(mapcar '(lambda(layname laycolor linetype linewidth)

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

混沌初开 发表于 2013-12-30 17:06:14

楼主是做冲压模具设计?

页: [1] 2

明经CAD社区's Archiver

自动建图层lsp