分享：entmake创建图层
本帖最后由 小万LISP 于 2019-10-3 10:01 编辑[*];新建图层：图层名 颜色 线宽 打印(0不、1打)
[*](defun NewLayer(TuCeng YanSe XianKuan P / )
[*](if (not(tblsearch "layer" "TuCeng"))
[*] (entmake
[*] (list
[*] '(0 . "LAYER")
[*] '(100 . "AcDbSymbolTableRecord")
[*] '(100 . "AcDbLayerTableRecord")
[*] '(70 . 0)
[*] '(6 . "Continous");线型
[*] (cons 2 TuCeng) ;图层名
[*] (cons 62 YanSe) ;颜色
[*] (cons 370 XianKuan);线宽，18=0.18
[*] (cons 290 P) ;是否打印,0不打印，1打印
[*] )
[*] )
[*])
[*](princ)
[*])
entmake layer
本帖最后由 sachindkini 于 2019-10-3 14:43 编辑(defun c:MakeLayers nil (vl-load-com)
;; © Lee Mac 2010
;;----------------------------------------------------------------------------------------------;;
;; Specifications: ;;
;;----------------------------------------------------------------------------------------------;;
;; Description Data Type Remarks ;;
;;----------------------------------------------------------------------------------------------;;
;; Layer Name STRING Only standard chars allowed. ;;
;; Layer Colour INTEGER may be nil, -ve for Layer Off, Colour < 256 ;;
;; Layer Linetype STRING may be nil, If not loaded, CONTINUOUS. ;;
;; Layer Lineweight REAL may be nil, negative=Default, otherwise 0 <= x <= 2.11 ;;
;; Plot? BOOLEAN T = Plot Layer, nil otherwise ;;
;; Bit Flag INTEGER 0=None, 1=Frozen, 2=Frozen in VP, 4=Locked ;;
;; Description STRING may be nil for no description ;;
;;----------------------------------------------------------------------------------------------;;
;; Function will print list detailing any unsuccesful layers ;;
;;----------------------------------------------------------------------------------------------;;
(regapp "AcAecLayerStandard")
(
(lambda ( lst )
(mapcar 'print
(vl-remove-if 'cdr
(mapcar
(function
(lambda ( x )
(if (caddr x) (LM:LoadLinetype (caddr x))) (cons (car x) (apply 'MakeLayer x))
)
)
lst
)
)
)
)
'(
;Name Colour Linetype Lineweight Plot? BitflagDescription
( "EL_COMPONENTS" 7"CONTINUOUS" -3 T 0 "componets")
( "EL_CONSTR_COMP" 1"CONTINUOUS" -3 T 0 "const" )
( "EL_FITTINGS" 4"CONTINUOUS" -3 T 0 "fitting")
( "EL_LABEL" 1"CONTINUOUS" -3 T 0 nil)
( "EL_LABEL_TXT" 252"CONTINUOUS" -3 T 0 nil)
( "EL_TERMINALS" 1"CONTINUOUS" -3 T 0 nil)
( "EL_TERMINALS_PE" 24"CONTINUOUS" -3 T 0 nil)
( "EL_TERMINALS_TXT" 252"CONTINUOUS" -3 T 0 nil)
( "EL_TXT" 252"CONTINUOUS" -3 T 0 nil)
( "EL_WIRES" 252"CONTINUOUS" -3 T 0 nil)
( "GE_ANNOTATION" 7"CONTINUOUS" -3 T 0 nil)
( "GE_LABEL" 10"CONTINUOUS" -3 T 0 nil)
( "GE_LABEL_TEXT" 253"CONTINUOUS" -3 T 0 nil)
( "GE_TXT_LANGUAGE_DU" 252"CONTINUOUS" -3 T 0 nil)
( "GE_TXT_LANGUAGE_EN" 252"CONTINUOUS" -3 T 0 nil)
( "GE_TXT_LANGUAGE_FR" 252"CONTINUOUS" -3 T 0 nil)
( "GE_TXT_LANGUAGE_GE" 252"CONTINUOUS" -3 T 0 nil)
( "LA_HEADER_FRAME" 7"CONTINUOUS" -3 T 0 nil)
( "LA_HEADER_TXT" 7"CONTINUOUS" -3 T 0 nil)
( "LA_MATLIST" 254"CONTINUOUS" -3 T 0 nil)
( "LA_MATLIST_FRAME" 254"CONTINUOUS" -3 T 0 nil)
( "LA_MATLIST_POS" 254"CONTINUOUS" -3 T 0 nil)
( "LA_MATLIST_TXT" 252"CONTINUOUS" -3 T 0 nil)
( "LA_TITLE_FRAME" 7"CONTINUOUS" -3 T 0 nil)
( "LA_TITLE_LOGO" 10"CONTINUOUS" -3 T 0 nil)
( "LA_TITLE_LOGO_TXT" 7"CONTINUOUS" -3 T 0 nil)
( "LA_TITLE_TXT" 7"CONTINUOUS" -3 T 0 nil)
( "LA_VIEWPORTS" 230"CONTINUOUS" -3 nil 0 nil)
( "PN_ACCESSORIES" 30"CONTINUOUS" -3 T 0 nil)
( "PN_ACTUATORS" 160"CONTINUOUS" -3 T 0 nil)
( "PN_AIR_LINE_EQUIPMENT" 40"CONTINUOUS" -3 T 0 nil)
( "PN_BRACKET_MOUNTING" 1"ACAD_ISO12W100" -3 T 0 nil)
( "PN_CABINET" 8"CONTINUOUS" -3 T 0 nil)
( "PN_CABINET_DIM" 8"CONTINUOUS" -3 T 0 nil)
( "PN_COMPONENTS" 7"CONTINUOUS" -3 T 0 nil)
( "PN_CONDUCTS" 3"CONTINUOUS" -3 T 0 nil)
( "PN_CONSTR_COMP" 2"CONTINUOUS" -3 T 0 nil)
( "PN_DRAIN" 3"HIDDEN" -3 T 0 nil)
( "PN_EXHAUST" 104"CONTINUOUS" -3 T 0 nil)
( "PN_FITTINGS" 30"CONTINUOUS" -3 T 0 nil)
( "PN_IDENTIFICATION" 4"CONTINUOUS" -3 T 0 nil)
( "PN_PILOT_SUPPLY" 3"HIDDEN" -3 T 0 nil)
( "PN_PORT_NUMBERS" 8"CONTINUOUS" -3 T 0 nil)
( "PN_PRESSURE_SWITCHES" 200"CONTINUOUS" -3 T 0 nil)
( "PN_PROPORTIONAL_VALVES" 226"CONTINUOUS" -3 T 0 nil)
( "PN_SECTIONS" 3"CONTINUOUS" -3 T 0 nil)
( "PN_SUB-BASES" 8"ACAD_ISO12W100" -3 T 0 nil)
( "PN_SUB-BASE_CONDUCTS" 2"CONTINUOUS" -3 T 0 nil)
( "PN_SUPPLY" 3"CONTINUOUS" -3 T 0 nil)
( "PN_TXT" 3"CONTINUOUS" -3 T 0 nil)
( "PN_VACUUM" 60"CONTINUOUS" -3 T 0 nil)
( "PN_VALVES" 240"CONTINUOUS" -3 T 0 nil)
( "PN_VALVES_OVERRIDE" 1"CONTINUOUS" -3 T 0 nil)
)
)
(princ)
)
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
;; © Lee Mac 2010
(or (tblsearch "LAYER" name)
(entmake
(append
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2name)
(cons 70 bitflag)
(cons 290 (if willplot 1 0))
(cons 6
(if (and linetype (tblsearch "LTYPE" linetype))
linetype "CONTINUOUS"
)
)
(cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
(cons 370
(if (minusp lineweight) -3
(fix
(* 100
(if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
)
)
)
)
)
(if description
(list
(list -3
(list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
)
)
)
)
)
)
)
;;--------------------=={ Load Linetype }==-------------------;;
;; ;;
;;Attempts to load a specified linetype from any linetype ;;
;;definition files (.lin) found in the ACAD Support Path ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lt - name of linetype to load ;;
;;------------------------------------------------------------;;
;;Returns:T if linetype loaded successfully, else nil ;;
;;------------------------------------------------------------;;
(defun LM:LoadLinetype ( lt )
(cond
( (tblsearch "LTYPE" lt) )
( (progn
(or acapp (setq acapp (vlax-get-acad-object)))
(or acdoc (setq acdoc (vla-get-ActiveDocument acapp)))
(or aclts (setq aclts (vla-get-Linetypes acdoc)))
(vl-some
(function
(lambda ( file )
(vl-catch-all-apply 'vla-load (list aclts lt file))
(and (tblsearch "LTYPE" lt))
)
)
(setq *LineTypeDefs*
(cond
( *LineTypeDefs* )
( (apply 'append
(mapcar '(lambda ( directory ) (vl-directory-files directory "*.lin" 1))
(LM:str->lst
(vla-get-SupportPath (vla-get-Files (vla-get-Preferences acapp))) ";"
)
)
)
)
)
)
)
)
)
)
)
;;-------------------=={ String to List }==-------------------;;
;; ;;
;;Separates a string into a list of strings using a ;;
;;specified delimiter string ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;str - string to process ;;
;;del - delimiter by which to separate the string ;;
;;------------------------------------------------------------;;
;;Returns:A list of strings ;;
;;------------------------------------------------------------;;
(defun LM:str->lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(vl-remove "" (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)))
(list str)
)
) entmake创建图元必要条件(慢慢更新) sachindkini 发表于 2019-10-3 14:37
人才！人才！人才！人才！
页:
[1]