练习LISP程序设计.doc

; 1 将现有图中的直线移到指定的图层。（图层由用户确定）(Defun c:LX1( / ly ss1 n i entnm b) (Setq ly (Getstring nLayer:) ；输入指定的图层名 (Setq ss1 (Ssget x (0 . line) ；现有图中直线的选择集 (Command change ss1 p la ly )Command: changeSelect objects: 1 foundSelect objects:Properties/: pChange what property (Color/Elev/LAyer/LType/ltScale/Thickness) ? laNew layer : linChange what property (Color/Elev/LAyer/LType/ltScale/Thickness) ?Command:CHANGE; 2 将现有的多段首尾相接的直线编辑成多义线。(Defun c:LX2() (Setq ss (Ssadd) ；定义一个空选择集 (Setq ssi (Entsel) ；（Entsel prompt）返回所选实体的名称及选取该实体的选点坐标。只能用点去选，不能用Window选，提示参数的缺省值是Select objects. (While (/= ssi nil) (Ssadd (car ssi) ss) (Setq ssi (entsel) )(Setq entnm (Ssname ss 0) ； (Ssname ss n) 获得选择集 ss 中的第 n 个图元名 (Command pedit entnm y j ss x)Command: peditSelect polyline:Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo/eXit : jSelect objects: 1 foundSelect objects: 1 foundSelect objects: 1 foundSelect objects: 1 foundSelect objects: 1 foundSelect objects: 1 found (1 duplicate)Select objects:4 segments added to polylineOpen/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo/eXit : xCommand:; 3 改变现有图中所有圆的颜色。（颜色由用户确定）(Defun c:LX3() (Setq col (Getint nColor:) (Setq ss1 (Ssget x (0 . circle) (Command change ss1 p c col ); 4 改变用户所选定实体的线型。（线型由用户确定）(Defun c:LX4() (Setq lt (Getstring nLinetype:) (Setq nm (Car (Entsel nSELECT OBJECT:) (Setq b (Entget nm) (Setq old (Assoc 6 b) (If (= old NIL) (Setq b (Cons (Cons 6 lt) b) (Setq b (subst (Cons 6 lt) old b) ) (Entmod b); 5 将目标变为当前层的颜色。(Defun c:LX5( / a) (Setq b (Getvar CLAYER) (Setq a (Entget (Car (Entsel nPick the SOURCE OBJECT) (Setq a (Subst (cons 8 b) (assoc 8 a) a) (Entmod a); 6 将目标 2 层变为目标 1 层。(Defun c:LX6( / a) (Setq a (Entget (Car (Entsel nPick the TARGET1 OBJECT) (Setq c (Entget (Car (Entsel nPick the TARGET2 OBJECT) (Setq b (Cdr (Assoc 8 c) (Setq a (Subst (Cons 8 b) (Assoc 8 a) a) (Entmod a); 7 将指定对象所在的图层变为当前层。(Defun c:LX7( / a) (setq a (Entget (Car (entsel nPick the SOURCE OBJECT) (Setq b (Cdr (Assoc 8 a) (Command Layer s b )(Defun c:LX7(/ a b) (setq a (getpoint n input point:) (setq a (Entget (Entlast) (Setq b (Entget (Car (Entsel nPick the TARGET1 OBJECT) (Setq b (Subst (Assoc 8 a) (Assoc 8 b) b) (Entmod b); 8 删除指定层上的所有实体。(Defun c:LX8() (Setq b (Getstring nLAYER:) (Command layer s b ) / 本行可删除 (Setq e (Ssget x (list (cons 8 b) (Command erase e ); 9 将图中