AutoLISP VisualLISP学习笔记
目录待整理
前言
时隔多年，又将Autolisp编程捡了起来，此处做个笔记，记录一下学习当中遇到的问题和需记录的知识点。
一、AutoCAD 图层状态文件（.las）格式解析
0
LAYERSTATEDICTIONARY -->图层状态字典标志
0
LAYERSTATE -->图层状态标志
1
test1 -->图层状态名称
91
2047
301 -->图层状态说明标识
----->图层状态说明，无说明则为空行
290 -->所属空间标识
0 ----->空间标识：0 模型控件，1 布局1
302 -->当前图层群码标识
0 ----->当前图层名称：string
8 -->名称群码标识
0 ----->图层名称：string
90 -->状态群码标识
8 ----->图层状态开关：非打印图层（ 0 图层开启不冻结不锁定， 1 仅关闭， 2 仅冻结， 3 关闭且冻结， 4 仅锁定， 5 关闭且锁定， 6 冻结且锁定， 7 图层关闭冻结且锁定）
打印图层（ 8 图层开启不冻结不锁定， 9 仅关闭，10 仅冻结，11 关闭且冻结，12 仅锁定，13 关闭且锁定，14 冻结且锁定，15 图层关闭冻结且锁定）
冻结新视口且非打印图层（16 图层开启不冻结不锁定，17 仅关闭，18 仅冻结，19 关闭且冻结，20 仅锁定，21 关闭且锁定，22 冻结且锁定，23 图层关闭冻结且锁定）
冻结新视口且打印图层（24 图层开启不冻结不锁定，25 仅关闭，26 仅冻结，27 关闭且冻结，28 仅锁定，29 关闭且锁定，30 冻结且锁定，31 图层关闭冻结且锁定）
62 -->颜色群码标识
7 ----->图层颜色：int
370 -->线宽群码标识
-3 ----->图层线宽：-3 默认，13 0.13mm等
6 -->线型群码标识
Continuous ----->图层线型：string
2 -->打印样式颜色标识
颜色_7 ----->打印样式颜色：Normal，颜色_#，根据设定的打印样式变化
440 -->透明度群码标识
0 ----->图层透明度：33554###
8
图层1
90
8
62
7
370
-3
6
Continuous
2
颜色_7
440
0
-->文件结束标志
二、环境变量设置、线型生成、图层生成
;;批量初始化系统变量
;;"PICKADD"--设置点击累加选择;;"PICKFIRST"--;;设置先选择后执行;;"TRIMEXTENDMODE"--设置剪切、延伸方式
;;"LTSCALE"--设置线型比例;;"LUPREC"--设置线性单位小数位数，AUNITS设置角度单位表示方式;;"AUPREC"--指定角度单位小数位数，LUNITS设置线性单位表示方式
(setq varlist '(("PICKADD" 2) ("PICKFIRST" 1) ("TRIMEXTENDMODE" 0) ("LTSCALE" 1000) ("LUPREC" 4) ("AUPREC" 4)))
(foreach x varlist
(if (/= (getvar (setq varname (car x))) (setq varnum (cadr x)))
(setvar varname varnum)
)
)
;;(mapcar '(lambda (x) (if (/= (getvar (setq varname (car x))) (setq varnum (cadr x))) (setvar varname varnum))) varlist)
;;批量生成内嵌线型
(setq ltlist '(("DASHED" (0 . "LTYPE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLinetypeTableRecord") (2 . "DASHED") (70 . 0) (3 . "Dashed __ __ __ __ __ __ __ __ __ __ __ __ __ _") (72 . 65) (73 . 2) (40 . 0.75) (49 . 0.5) (49 . -0.25))
("DOTE" (0 . "LTYPE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLinetypeTableRecord") (2 . "DOTE") (70 . 0) (3 . "____ . ____ . ____ . ____ . ____ . ____ . ____ ") (72 . 65) (73 . 4) (40 . 2.42) (49 . 2.0) (49 . -0.2) (49 . 0.02) (49 . -0.2))))
(foreach x ltlist
(progn
(setq e (tblobjname "ltype" (car x)))
(if e (entmod (cons (cons -1 e) (cdr x))) (entmakex(cdr x)))
)
)
;;图层生成修改函数1
;;(函数名 图层信息表 打印标志)
;;(gen_layer layerinfolist dayinflag)
;;layerinfolist->(层名 颜色 线型 线宽 图层说明)
(vl-load-com)
(defun gen_layer (lay dayin / cengming yanse xianxing xiankuan shuoming cadOBJ cadDOC docLAYERS layOBJ)
(if (listp lay)
(setq cengming (nth 0 lay) yanse (nth 1 lay) xianxing (nth 2 lay) xiankuan (nth 3 lay) shuoming (nth 4 lay))
)
(setq cadDOC (vla-get-ActiveDocument (setq cadOBJ (vlax-get-acad-object))))
(setq docLAYERS (vla-get-Layers cadDOC)) ;选择所有图层
(setq layOBJ (vla-add docLAYERS cengming)) ;选择或新建图层，AutoCad中图层名称不区分大小写
(vla-put-LayerOn layOBJ :vlax-true) ;图层开关
(vla-put-Freeze layOBJ :vlax-false) ;图层不冻结
(vla-put-Lock layOBJ :vlax-false) ;图层不锁定
(if dayin
(vla-put-Plottable layOBJ :vlax-true)
(vla-put-Plottable layOBJ :vlax-false)
) ;图层打印
(vla-put-Color layOBJ yanse) ;颜色：1=红 2=黄 3=绿 4=青 5=蓝 6=洋红 7=白 8=深灰 9=浅灰
(vla-put-Linetype layOBJ xianxing) ;线型：DOTE CONTINUOUS DASHED
(vla-put-Lineweight layOBJ (* 100 xiankuan)) ;线宽:默认acLnWtByLwDefault
(vla-put-Description layOBJ shuoming) ;设置图层说明
(vla-put-ActiveLayer cadDOC (vla-get-ActiveLayer cadDOC)) ;重置当前活动图层，避免AutoLISP机制上图层设置可能未生效问题
)
(setq laylist '("test5" 5 "DASHED" 0.13 "图层生层测试1"))
(gen_layer laylist t) ;;(gen_layer laylist nil)
;;图层生成函数2
;用entmake创建图层
;(jianceng cengming yanse xianxing xiankuan dayin flag)
;(jianceng 层名 颜色 线型 线宽 打印 同名是否强制更新)
(defun jianceng (cengming yanse xianxing xiankuan dayin flag)
(or xianxing (setq xianxing "Continuous"))
(or xiankuan (setq xiankuan 13))
(or dayin (setq dayin 1))
(or yanse (setq yanse 7))
;自动加载线型 Gu_xl 2013-5-29 <a href="http://bbs.mjtd.com/forum.php?mo" target="_blank">http://bbs.mjtd.com/forum.php?mo</a> ... mp;page=2#pid588571
(and xianxing
(or (TBLSEARCH "LTYPE" xianxing) ;线型
(vl-catch-all-apply 'vla-load (list (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))) xianxing ;线型
(findfile "acad.lin")))
)
)
(and cengming
(if (and (setq en (tblobjname "layer" cengming)) flag)
(progn ;强制更新
(setq elist (entget en))
(and yanse (setq elist (subst (cons 62 yanse) (assoc 62 elist) elist)))
(and xianxing (setq elist (subst (cons 6 xianxing) (assoc 6 elist) elist)))
(and xiankuan (setq elist (subst (cons 370 xiankuan) (assoc 370 elist) elist)))
(and dayin (setq elist (subst (cons 290 dayin) (assoc 290 elist) elist)))
(entmod elist)
)
(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0)
(cons 2 cengming) ;层名
(cons 62 yanse) ;颜色
(cons 6 xianxing) ;线型
(cons 370 xiankuan) ;线宽，100=1
(cons 290 dayin) ;0不打印，1打印
)
)
)
)
(princ)
)
(defun c:make_layer()
; (函数名 层名 颜色 线型 线宽 打印 标志)
;(jianceng cengming yanse xianxing xiankuan dayin flag)
;(jianceng 层名 颜色 线型 线宽 打印 同名是否强制更新)
(jianceng "A" 1 "center" 100 0 t)
(jianceng "B" 2 nil nil nil t)
(jianceng "C" 3 nil nil nil t)
(jianceng "D" 4 nil nil nil t)
(princ)
)
;;图层生成函数3
(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 ;;
;;----------------------------------------------------------------------------------------------;;
((lambda (lst) (mapcar 'print (vl-remove-if 'cdr (mapcar (function (lambda ( x ) (and (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 nil ) ( "EL_CONSTR_COMP" 1 "CONTINUOUS" -3 T 0 nil )
( "EL_FITTINGS" 4 "CONTINUOUS" -3 T 0 nil ) ( "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 color 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 color (< 0 (abs color) 256)) color 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)
(vl-load-com)
(cond
((tblsearch "LTYPE" lt))
((progn
(or acdoc (setq acdoc (vla-get-ActiveDocument (setq acapp (vlax-get-acad-object)))))
(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)
)
)
总结
待总结
扫一扫
1398
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
