[原创]：智能的“命令提取”LSP函数

wangdong

该程序如对你有帮助，请捧个场。   

                  智能的“命令提取”LSP函数

一,引言
   在ACAD绘图中,经常有这样的情形:图中已有一实体,例如一
"POLYLINE"实体,该实体处于图中的GJ层;线型为XX100;颜色为
RED;线宽为0.45.而当前的层;线型;颜色;线宽均不为上述值.
而这时又需要在上述"POLYLINE"实体所在的GJ层,绘制与该实
体具有相同的线型;相同的颜色;相同的线宽的另一"POLYLINE"
实体或其他实体时,如仅用ACAD命令操作需频繁调用ACAD菜单
或命令,如遗忘了某一特性还要现场查询,颇为费时.能否当点
选图中一实体后,便根据所点选的实体类型自动提取其相应的
特性且自动设置为当前特性,而且同时调用该实体的ACAD绘图
命令呢?答案是肯定的.例如当点选图中一文字"TEXT"实体后,
便自动将当前层设置为该文字所在图层;当前颜色设置为该文
字的颜色;当前文字的高度,字型等特性均设置为该文字的特性
且自动调用TEXT命令以进行文字书写,仿佛机算机明白操作者
的意图一般.这便是本文所提供的智能的"命令提取"功能.希望
能抛砖引玉。
二,程序设计思想
   程序首先利用entsel函数提示用户点选一实体,当选中一实
体后entsel函数返回该实体的实体名e_name,然后用entget函数
提取该实体的DXF数据e_data,再由e_data提取该实体的主实体类
型e_type,再根据e_type的不同情况分别处理,详见所附原程序.
这里需要说明的是,当主实体类型e_type为多义线"POLYLINE"时,
由于ACAD的绘图命令如多义线"PLINE"圆环"DONUT";椭圆"ELLIPSE"
多边形"POLYGON"等命令生成的实体的主实体类型均为多义线
"POLYLINE",因此此时应继续提取其子实体的DXF数据,以进一步
对所选实体进行判断.所附原程序仅对圆环"DONUT"做出判断,其余
实体的判断如认为有必要可自行加入.
三,程序调用方法
   用(load "mltq")命令将所附原程序MLTQ.LSP装入后,键入MLTQ
后便可调用.
四,源程序

2. 
   
3. ;;;dxf函数接受实体的DXF码,返回特性数据
   
4. (defun dxf (code elist)
   
5.   (cdr (assoc code elist))
   
6. )
   
7. ;;;mltq命令提取主函数
   
8. (defun c:mltq (/ mlst e_name e_data e_type e_layer
   
9.                  e_width e_ltype e_color ename1
   
10.                  edata1 xpt1 ename2 edata2 xpt2
    
11.                  bulge insd outd)
    
12.   (setvar "CMDECHO" 0)
    
13.   (setq e_name (car (entsel "\n选择实体进行命令提取:\n")))
    
14.   (if e_name
    
15.     (progn
    
16.       (setq e_data (entget e_name))
    
17.       (setq e_type (dxf 0 e_data))   ;;;取主实体类型
    
18.       (if (= e_type "POLYLINE")
    
19.         (progn
    
20.           ;;;取实体所在图层
    
21.           (setq e_layer (dxf 8 e_data)     
    
22.                 e_width  (dxf 40 e_data)   ;;;取实体的宽度
    
23.                 e_ltype (dxf 6 e_data)     ;;;取实体的线型
    
24.                 e_color (dxf 62 e_data))   ;;;取实体的颜色
    
25.           (if (not e_ltype) (setq e_ltype "BYLAYER"))
    
26.           (if (not e_color) (setq e_color "BYLAYER"))
    
27.           (command "LAYER" "Set" e_layer "")
    
28.           (command "COLOR" e_color)
    
29.           (command "LINETYPE" "Set" e_ltype "")
    
30.           (setvar "PLINEWID" e_width)
    
31.            ;取第一子实体类型
    
32.           (setq ename1 (entnext e_name))
    
33.            ;取第一子实体数据
    
34.           (setq edata1 (entget ename1))
    
35.            ;取第一子实体顶点坐标
    
36.           (setq xpt1 (car (dxf 10 edata1)))
    
37.            ;取第一子实体凸度
    
38.           (setq bulge (dxf 42 edata1))
    
39.           (if (/= bulge 1)
    
40.             (progn (princ "\nPLINE") (command "PLINE")))
    
41.           (if (= bulge 1)
    
42.             (progn
    
43.               ;取第二子实体类型
    
44.               (setq ename2 (entnext ename1))
    
45.               ;取第二子实体数据
    
46.               (setq edata2 (entget ename2))
    
47.               ;取第二子实体顶点坐标
    
48.               (setq xpt2 (car (dxf 10 edata2)))
    
49.               ;求得圆环内径
    
50.               (setq insd (- (abs (- xpt2 xpt1)) e_width))
    
51.               ;求得圆环外径
    
52.               (setq outd (+ (abs (- xpt2 xpt1)) e_width))
    
53.               (setvar "DONUTID" insd)
    
54.               (setvar "DONUTOD" outd)
    
55.               (princ "\nDOUNT")
    
56.               (command "DONUT")
    
57.             )
    
58.           )
    
59.         )
    
60.       )
    
61.       (if (or (= e_type "LINE")
    
62.               (= e_type "ARC")
    
63.               (= e_type "CIRCLE")
    
64.           )
    
65.         (progn
    
66.           (setq e_layer (dxf 8 e_data);取实体所在图层
    
67.                 e_ltype (dxf 6 e_data);取实体的线型
    
68.                 e_color (dxf 62 e_data));取实体的颜色
    
69.           (if (not e_ltype) (setq e_ltype "BYLAYER"))
    
70.           (if (not e_color) (setq e_color "BYLAYER"))
    
71.           (command "LAYER" "Set" e_layer "")
    
72.           (command "COLOR" e_color)
    
73.           (command "LINETYPE" "Set" e_ltype "")
    
74.           (cond
    
75.             ((= e_type "LINE") (princ "\nLINE")
    
76.              (command "LINE"))
    
77.             ((= e_type "ARC") (princ "\nARC")
    
78.              (command "ARC"))   
    
79.             ((= e_type "CIRCLE") (princ "\nCIRCLE")
    
80.              (command "CIRCLE"))   
    
81.           )
    
82.         )
    
83.       )
    
84.       (if (= e_type "TEXT")
    
85.         (progn
    
86.           (setq e_layer (dxf 8 e_data);取文字所在图层
    
87.                 e_style (dxf 7  e_data);取文字字体
    
88.                 e_color (dxf 62 e_data);取文字的颜色
    
89.                 e_height (dxf 40 e_data);取文字高度
    
90.                 e_angle (dxf 50 e_data);取文字旋转角度
    
91.                 e_scale (dxf 41 e_data));取文字X向相对比例
    
92.           (if (not e_color) (setq e_color "BYLAYER"))
    
93.           (command "LAYER" "Set" e_layer "")
    
94.           (command "COLOR" e_color)
    
95.           (setvar "TEXTSTYLE" e_style)
    
96.           (setvar "TEXTSIZE" e_height)
    
97.           (princ "\nTEXT")
    
98.           (command "TEXT")
    
99.         )
    
100.       )
     
101.     )
     
102.   )
     
103.   (setvar "CMDECHO" 1)
     
104.   (princ)
     
105. )

<br /> ;;;dxf函数接受实体的DXF码,返回特性数据<br /> (defun dxf (code elist)<br />   (cdr (assoc code elist))<br /> )<br /> ;;;mltq命令提取主函数<br /> (defun c:mltq (/ mlst e_name e_data e_type e_layer <br />                  e_width e_ltype e_color ename1 <br />                  edata1 xpt1 ename2 edata2 xpt2 <br />                  bulge insd outd)<br />   (setvar "CMDECHO" 0)<br />   (setq e_name (car (entsel "\n选择实体进行命令提取:\n")))<br />   (if e_name <br />     (progn<br />       (setq e_data (entget e_name))<br />       (setq e_type (dxf 0 e_data))   ;;;取主实体类型<br />       (if (= e_type "POLYLINE") <br />         (progn<br />           ;;;取实体所在图层<br />           (setq e_layer (dxf 8 e_data)     <br />                 e_width  (dxf 40 e_data)   ;;;取实体的宽度<br />                 e_ltype (dxf 6 e_data)     ;;;取实体的线型<br />                 e_color (dxf 62 e_data))   ;;;取实体的颜色<br />           (if (not e_ltype) (setq e_ltype "BYLAYER"))<br />           (if (not e_color) (setq e_color "BYLAYER"))<br />           (command "LAYER" "Set" e_layer "")<br />           (command "COLOR" e_color)<br />           (command "LINETYPE" "Set" e_ltype "")<br />           (setvar "PLINEWID" e_width)<br />            ;取第一子实体类型 <br />           (setq ename1 (entnext e_name)) <br />            ;取第一子实体数据<br />           (setq edata1 (entget ename1)) <br />            ;取第一子实体顶点坐标<br />           (setq xpt1 (car (dxf 10 edata1)))<br />            ;取第一子实体凸度<br />           (setq bulge (dxf 42 edata1))<br />           (if (/= bulge 1) <br />             (progn (princ "\nPLINE") (command "PLINE")))<br />           (if (= bulge 1) <br />             (progn<br />               ;取第二子实体类型 <br />               (setq ename2 (entnext ename1)) <br />               ;取第二子实体数据<br />               (setq edata2 (entget ename2)) <br />               ;取第二子实体顶点坐标<br />               (setq xpt2 (car (dxf 10 edata2)))<br />               ;求得圆环内径<br />               (setq insd (- (abs (- xpt2 xpt1)) e_width))<br />               ;求得圆环外径<br />               (setq outd (+ (abs (- xpt2 xpt1)) e_width)) <br />               (setvar "DONUTID" insd) <br />               (setvar "DONUTOD" outd)<br />               (princ "\nDOUNT")<br />               (command "DONUT")<br />             )<br />           )<br />         )<br />       )<br />       (if (or (= e_type "LINE")<br />               (= e_type "ARC")<br />               (= e_type "CIRCLE")<br />           )<br />         (progn<br />           (setq e_layer (dxf 8 e_data);取实体所在图层<br />                 e_ltype (dxf 6 e_data);取实体的线型<br />                 e_color (dxf 62 e_data));取实体的颜色<br />           (if (not e_ltype) (setq e_ltype "BYLAYER"))<br />           (if (not e_color) (setq e_color "BYLAYER"))<br />           (command "LAYER" "Set" e_layer "")<br />           (command "COLOR" e_color)<br />           (command "LINETYPE" "Set" e_ltype "")<br />           (cond <br />             ((= e_type "LINE") (princ "\nLINE")<br />              (command "LINE"))<br />             ((= e_type "ARC") (princ "\nARC")<br />              (command "ARC"))   <br />             ((= e_type "CIRCLE") (princ "\nCIRCLE")<br />              (command "CIRCLE"))   <br />           )<br />         )<br />       )<br />       (if (= e_type "TEXT")<br />         (progn<br />           (setq e_layer (dxf 8 e_data);取文字所在图层<br />                 e_style (dxf 7  e_data);取文字字体 <br />                 e_color (dxf 62 e_data);取文字的颜色<br />                 e_height (dxf 40 e_data);取文字高度<br />                 e_angle (dxf 50 e_data);取文字旋转角度 <br />                 e_scale (dxf 41 e_data));取文字X向相对比例<br />           (if (not e_color) (setq e_color "BYLAYER"))<br />           (command "LAYER" "Set" e_layer "")<br />           (command "COLOR" e_color)<br />           (setvar "TEXTSTYLE" e_style)<br />           (setvar "TEXTSIZE" e_height) <br />           (princ "\nTEXT")<br />           (command "TEXT") <br />         )<br />       )<br />     )<br />   )<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )

cjrun

还不是很完善，不过用的人自己再改进一下就很好用了！

bridgewind

泄的可以，学习学习！

wangdong

大家试用一下吧，怎么回音这么少？

秋枫

设想不错。

e2002

这是一篇老文章了,和另外一篇关于"特定角度捕捉"的文章一样,好像都是在www.chinacad.com上的(1998年?),当时我琢磨了很久,觉得对自己帮助很多.
后来自己也写了这样的一个程序,不过实际工作中发现用户很少使用这个,我分析是大家已经有很深的习惯性的操作方式,如双击对象编辑,条件发射似的选择命令....
故而在最新的LKPT for 200x 中取消了这个程序.

wangdong

e2002斑竹你说的没错，这是我1998年发表在《CAD 与智能建筑》杂志上的一篇
文章，程序我一直再用，由于时间关系没有完善，拿出来就是想听听大家的意见。

e2002

原来wang兄就是作者啊,幸会幸会!你的文章非常好,对我还有很多当时刚开始学习AutoLISP初学者帮助很大,非常感谢!
希望wang兄在论坛多多指教,发布更多有价值的原创好文!

wangdong

谢谢斑竹加积分和爱心币，我会继续努力。

仙外飞天

你的这篇文章我也看过的，虽然不是太使用（我认为的），但是拿来作为学习材料还是蛮好的。

mechal

不错的想法

binbin

cad命令：_matchprop