entmake lisp 对齐_分享：entmake创建图层 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

(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? Bitflag  Description

( "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 2  name)

(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)

)

)