[源码]提取DXF组码

cabinsummer · 发表于 2011-9-5 22:04:04

本帖最后由 cabinsummer 于 2016-12-24 15:16 编辑

(defun C:DXF
(
/
DCL_ID ERRMSG PICK_ENT TILES_ONOFF
DXF_ERROR NEXT_ENT SHOW_LIST WHAT_NEXT
ENT_LIST OLD_CMDECHO SHOW_NEXT_ENT OUTPUT_LIST
LIST_POINTER NEW_ITEM SHOW_FEATURES ENTITY_TYPE
GET_FEATURES RESET_VALUES FLAG SELECTED_ITEM
RANGE_LISTS POINT_3D EDITBOX_VALUE BITS_FLAG
CALCULATE_BITS_SUM
TILES_NAME TILES_VALUE
)
(defun DXF_ERROR ( ERRMSG )
(if
(and
(/= ERRMSG "功能取消")
(/= ERRMSG "退出程序")
)
(princ (strcat "\nDXF应用程序错误: " ERRMSG "\n"))
)
(setvar "CMDECHO" OLD_CMDECHO)
(setq *error* OLD_ERROR)
(setq
DCL_ID nil NEXT_ENT nil SHOW_NEXT_ENT nil
DXF_ERROR nil OLD_CMDECHO nil TILES_ONOFF nil
ENT_LIST nil PICK_ENT nil WHAT_NEXT nil
ERRMSG nil SHOW_LIST nil OUTPUT_LIST nil
LIST_POINTER nil
)
(princ)
)
(defun GET_FEATURES
(
ENTITY_TYPE FLAG SUBCLASS
/
ENT DIMSTYLE_LIST GETDIMSTYLE GETLAYER LAYERS_LIST
TXTSTYLE_LIST GETTXTSTYLE
)
(setq GETLAYER (cdr (assoc 2 (tblnext "LAYER" T))))
(while GETLAYER
(setq LAYERS_LIST (append LAYERS_LIST (list GETLAYER)))
(setq GETLAYER (cdr (assoc 2 (tblnext "LAYER"))))
)
(setq LAYERS_LIST (acad_strlsort LAYERS_LIST))
(setq GETTXTSTYLE (cdr (assoc 2 (tblnext "STYLE" T))))
(while GETTXTSTYLE
(setq TXTSTYLE_LIST (append TXTSTYLE_LIST (list GETTXTSTYLE)))
(setq GETTXTSTYLE (cdr (assoc 2 (tblnext "STYLE"))))
)
(setq DIMSTYLE_LIST (acad_strlsort TXTSTYLE_LIST))
(setq GETDIMSTYLE (cdr (assoc 2 (tblnext "DIMSTYLE" T))))
(while GETDIMSTYLE
(setq DIMSTYLE_LIST (append DIMSTYLE_LIST (list GETDIMSTYLE)))
(setq GETDIMSTYLE (cdr (assoc 2 (tblnext "DIMSTYLE"))))
)
(setq DIMSTYLE_LIST (acad_strlsort DIMSTYLE_LIST))
(cond
((= FLAG -1)
(list
(list "图元名")
nil nil nil nil
)
)
((= FLAG 0) (list (list "图元类型") nil nil nil nil))
((= FLAG 5) (list (list "图元句柄") nil nil nil nil))
((= FLAG 102)
(list
(list "供应用程序使用的控制字符串")
nil nil nil nil
)
)
((= FLAG 100) (list (list "子类数据标记") nil nil nil nil))
((= FLAG 67)
(list
(list "模型空间/图纸空间")
(list
(list 0 1)
(list
"0\t模型空间"
"1\t图纸空间"
)
)
nil nil nil
)
)
((= FLAG 8)
(list (list "图层名") (list LAYERS_LIST LAYERS_LIST) nil nil nil)
)
((= FLAG 6)
(list
(list
"线型名(随层)."
"线型名(随块)."
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 62)
(list
(list
"颜色号 0 = 随块.256 = 随层."
"负值表示层关闭. 禁止(选项)."
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 48)
(list
(list "线型比例(选项)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 60)
(list
(list "可见性(选项)")
(list (list 0 1) (list "0\t可见" "1\t不可见")) nil nil nil
)
)
((= ENTITY_TYPE "CIRCLE")
(cond
((= FLAG 39)
(list
(list "厚度 (选项; 缺省 = 0)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 10)
(list
(list "中心点 (OCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 40) (list (list "半径") nil (cdr (assoc FLAG ENT_LIST)) nil nil))
((= FLAG 210)
(list
(list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
(T (list nil nil nil nil nil))
)
)
((= ENTITY_TYPE "DIMENSION")
(cond
((= FLAG 2)
(list
(list "包含构成标注图片的图元的块的名称")
nil nil nil nil
)
)
((= FLAG 10)
(list
(list "定义点(WCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 11)
(list
(list "标注文字的中点(OCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 70)
(list
(list "标注类型")
nil nil nil (list (cdr (assoc FLAG ENT_LIST)) (list 32 64 128))
)
)
((= FLAG 1)
(list
(list "由用户明确输入的标注文字")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 53)
(list
(list
"标注文字与其默认方向所成的旋转角度"
"(尺寸线方向)"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 51)
(list
(list
"所有标注类型均有可选的51组码，表示标注图元的水平方向"
"标注图元决定水平、垂直和旋转线性标注的标注文字和直线的方向"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 3)
(list
(list "标注样式名")
(list DIMSTYLE_LIST DIMSTYLE_LIST) nil nil nil
)
)
((= FLAG 210)
(list
(list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 12) (= SUBCLASS "AcDbAlignedDimension"))
(list
(list
"标注克隆的插入点:"
"基线和连续(OCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 13) (= SUBCLASS "AcDbAlignedDimension"))
(list
(list
"线性标注和角度标注的定义点(WCS中): 3D点"
"指定的第一个延长线的起点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 14) (= SUBCLASS "AcDbAlignedDimension"))
(list
(list
"线性标注和角度标注的定义点(WCS中): 3D点"
"指定的第二个延长线的起点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 50)
(list
(list "转角标注、水平标注或垂直标注的角度")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 52)
(list
(list
"带倾斜角的线性标注类型有可选组码 52。"
"当添加到线性标注的旋转角度(组码 50)时，将给出尺寸界线的角度"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
(
(and
(= FLAG 15)
(member SUBCLASS (list "AcDbRadialDimension" "AcDbDiametricDimension"))
)
(list
(list
"直径标注、半径标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
(
(and
(= FLAG 40)
(member SUBCLASS (list "AcDbRadialDimension" "AcDbDiametricDimension"))
)
(list
(list "半径标注和直径标注的引线长度")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((and (= FLAG 13) (= SUBCLASS "AcDb3PointAngularDimension"))
(list
(list
"线性标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 14) (= SUBCLASS "AcDb3PointAngularDimension"))
(list
(list
"线性标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 15) (= SUBCLASS "AcDb3PointAngularDimension"))
(list
(list
"直径标注、半径标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 16) (= SUBCLASS "AcDb3PointAngularDimension"))
(list
(list
"定义角度标注的标注圆弧的点"
"(OCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 13) (= SUBCLASS "AcDbOrdinateDimension"))
(list
(list
"线性标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((and (= FLAG 14) (= SUBCLASS "AcDbOrdinateDimension"))
(list
(list
"线性标注和角度标注的定义点"
"(WCS中): 3D点"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
(T (list nil nil nil nil nil))
)
)
((= ENTITY_TYPE "LINE")
(cond
((= FLAG 39)
(list
(list "厚度(选项; 缺省 = 0)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 10)
(list
(list "起点(WCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 11)
(list
(list "终点(WCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 210)
(list
(list
"拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
(T (list nil nil nil nil nil))
)
)
((= ENTITY_TYPE "MTEXT")
(cond
((= FLAG 10)
(list
(list "插入点 DXF: 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 40)
(list (list "缺省文字高度")
nil (cdr (assoc FLAG ENT_LIST)) nil)
)
((= FLAG 41)
(list
(list "参照矩形宽度")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 71)
(list
(list "附着点")
(list
(list 1 2 3 4 5 6 7 8 9)
(list
"1\t左上"
"2\t中上"
"3\t右上"
"4\t左中"
"5\t正中"
"6\t右中"
"7\t左下"
"8\t中下"
"9\t右下a"
)
)
nil nil nil
)
)
((= FLAG 72)
(list
(list "图形方向")
(list
(list 1 2 3 4)
(list
"1\t从左至右"
"2\t从右至左"
"3\t从上到下"
"4\t从下到上"
"5\t随式样"
)
)
nil nil nil
)
)
((= FLAG 1)
(list
(list
"字符串。如果字符串长度小于250个字符，所有字符均出现在组1中。"
"如果字符串长度大于250个字符，该字符串将分成长度为250个字符的数据块"
"并显示在一个或多个组3代码中。如果使用组3代码，最后一个组将是组1 且字符数少于250个"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 3)
(list
(list "附加文字(始终在长度为 250 个字符的数据块中).")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 7)
(list
(list "文字样式名(如果未提供，则为: STANDARD)")
(list TXTSTYLE_LIST TXTSTYLE_LIST) nil nil nil
)
)
((= FLAG 210)
(list
(list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 11)
(list
(list "方向矢量(WCS中): 3D矢量.")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 42)
(list
(list
"构成多行文字图元的字符的水平宽度"
"该值始终等于或小于组码41的值"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 43)
(list
(list "多行文字图元的垂直高度")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 50)
(list
(list "以弧度为单位的旋转角度")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
(T (list nil nil nil nil nil))
)
)
((= ENTITY_TYPE "TEXT")
(cond
((= FLAG 39)
(list
(list "厚度(选项; 缺省 = 0)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 10)
(list
(list "第一对齐点(OCS中): 3D点")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 40) (list (list "文字高度") nil (cdr (assoc FLAG ENT_LIST)) nil))
((= FLAG 1)
(list
(list "默认值(字符串本身)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 50)
(list
(list "文字旋转角度(选项, 缺省 = 0)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 41)
(list
(list
"相对X缩放比例: 宽度(选项; 缺省 = 1)."
"使用拟合类型的文字时, 该值也将进行调整"
)
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 51)
(list
(list "倾斜角(选项, 缺省 = 0)")
nil (cdr (assoc FLAG ENT_LIST)) nil nil
)
)
((= FLAG 7)
(list
(list "文字样式名(选项, 缺省 = STANDARD)")
(list TXTSTYLE_LIST TXTSTYLE_LIST) nil nil nil
)
)
((= FLAG 71)
(list
(list
"文字生成标志(选项, 缺省 = 0)"
"2 = 文字反向(在X轴方向镜像), 4 = 文字倒置(在Y轴方向镜像)"
)
nil nil nil (list (cdr (assoc FLAG ENT_LIST)) (list 2 4))
)
)
((= FLAG 72)
(list
(list
"文字水平对正类型(选项, 缺省 = 0)"
"整数代码(非按位编码)"
)
(list
(list 0 1 2 3 4 5)
(list
"0\t左对正"
"1\t居中对正"
"2\t右对正"
"3\t对齐(如果垂直对齐 = 0)"
"4\t中间(如果垂直对齐 = 0)"
"5\t拟合(如果垂直对齐 = 0)"
)
)
nil nil nil
)
)
((= FLAG 11)
(list
(list
"第二对齐点(OCS中): 3D点. 只有当72或73组的值非零时，该值才有意义"
"(如果对正不是基线对正/左对正)"
)
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 210)
(list
(list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量")
nil nil (cdr (assoc FLAG ENT_LIST)) nil
)
)
((= FLAG 73)
(list
(list
"文字垂直对正类型(选项, 缺省 = 0)"
"整数代码(不是按位编码)"
)
(list
(list 0 1 2 3)
(list
"0\t基线对正"
"1\t底端对正"
"2\t居中对正"
"3\t顶端对正"
)
)
nil nil nil
)
)
(T (list nil nil nil nil nil))
)
)
(T (list nil nil nil nil nil))
)
)
(defun PICK_ENT ( / ENT )
(if (= LEVEL_FLAG "0")
(setq ENT (entsel))
(setq ENT (nentsel))
)
(if (null ENT)
(progn
(alert "没有实体选择")
(setq NEXT_ENT nil)
)
(progn
(setq NEXT_ENT (entnext (car ENT)))
(setq ENT_LIST (entget (car ENT)))
)
)
)
(setq ACADLIBTEMP "C:\\Documents and Settings\\Administrator\\Application Data")
(defun SHOW_LIST ( / FHANDLE ITEM POINTER )
(setq FHANDLE (open (strcat ACADLIBTEMP "/DXF.TXT") "w"))
(setq POINTER 0)
(while (setq ITEM (nth POINTER ENT_LIST))
(prin1 ITEM FHANDLE)
(write-line "" FHANDLE)
(setq POINTER (1+ POINTER))
)
(close FHANDLE)
(setq FHANDLE (open (strcat ACADLIBTEMP "/DXF.TXT") "r"))
(setq OUTPUT_LIST nil)
(while (setq ITEM (read-line FHANDLE))
(setq OUTPUT_LIST (append OUTPUT_LIST (list item)))
)
(close FHANDLE)
(start_list "output_list")
(mapcar 'add_list OUTPUT_LIST)
(end_list)
(setq ENTITY_TYPE (cdr (assoc 0 ENT_LIST)))
(set_tile "entity_type" ENTITY_TYPE)
(set_tile "flag" "")
(set_tile "subclass_type" "")
(set_tile "flag_descr_01" "")
(set_tile "flag_descr_02" "")
)
(defun SHOW_NEXT_ENT ()
(setq
ENT NEXT_ENT
ENT_LIST (entget ENT)
NEXT_ENT (entnext ENT)
)
(show_list)
(reset_values)
)
(defun RESET_VALUES ()
(start_list "popup_value")
(end_list)
(set_tile "editbox_value" "")
(set_tile "x_point" "")
(set_tile "y_point" "")
(set_tile "z_point" "")
(mode_tile "popup_value" 1)
(mode_tile "editbox_value" 1)
(mode_tile "x_point" 1)
(mode_tile "y_point" 1)
(mode_tile "z_point" 1)
(mode_tile "go_subst" 1)
(mode_tile "bit_1" 1)
(mode_tile "bit_2" 1)
(mode_tile "bit_4" 1)
(mode_tile "bit_8" 1)
(mode_tile "bit_16" 1)
(mode_tile "bit_32" 1)
(mode_tile "bit_64" 1)
(mode_tile "bit_128" 1)
)
(defun SHOW_FEATURES
(
LIST_POINTER
/
DESCR_01 DESCR_02 ITEM POINTER RET_LIST SUBCLASS BITS_VALUE BITS_RANGE
COUNTER TILE_NAME TILE_VALUE OLD_BITS_VALUE
)
(setq POINTER LIST_POINTER)
(while (and (> POINTER 0) (null SUBCLASS))
(setq ITEM (nth POINTER ENT_LIST))
(if (= (car ITEM) 100)
(setq SUBCLASS (cdr ITEM))
)
(setq POINTER (1- POINTER))
)
(setq
SELECTED_ITEM (nth LIST_POINTER ENT_LIST)
FLAG (car SELECTED_ITEM)
RET_LIST (get_features ENTITY_TYPE FLAG SUBCLASS)
DESCR_01 (car (nth 0 RET_LIST))
DESCR_02 (cadr (nth 0 RET_LIST))
)
(set_tile "flag" (itoa FLAG))
(if SUBCLASS
(set_tile "subclass_type" SUBCLASS)
(set_tile "subclass_type" "")
)
(if DESCR_01
(set_tile "flag_descr_01" DESCR_01)
(set_tile "flag_descr_01" "")
)
(if DESCR_02
(set_tile "flag_descr_02" DESCR_02)
(set_tile "flag_descr_02" "")
)
(reset_values)
(cond
((setq RANGE_LISTS (nth 1 RET_LIST))
(start_list "popup_value")
(mapcar 'add_list (cadr RANGE_LISTS))
(end_list)
(mode_tile "popup_value" 0)
(set_tile
"popup_value"
(itoa
(-
(length (car RANGE_LISTS))
(length (member (cdr SELECTED_ITEM) (car RANGE_LISTS)))
)
)
)
(action_tile
"popup_value"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (cons FLAG (nth (atoi $value) (car RANGE_LISTS))))"
)
)
((setq EDITBOX_VALUE (nth 2 RET_LIST))
(mode_tile "editbox_value" 0)
(cond
((= (type EDITBOX_VALUE) 'STR)
(progn
(set_tile "editbox_value" EDITBOX_VALUE)
(action_tile
"editbox_value"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (cons FLAG $value))"
)
)
)
((= (type EDITBOX_VALUE) 'INT)
(progn
(set_tile "editbox_value" (itoa EDITBOX_VALUE))
(action_tile
"editbox_value"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (cons FLAG (atoi $value)))"
)
)
)
((= (type EDITBOX_VALUE) 'REAL)
(progn
(set_tile "editbox_value" (rtos EDITBOX_VALUE 2 16))
(action_tile
"editbox_value"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (cons FLAG (atof $value)))"
)
)
)
)
)
((setq POINT_3D (nth 3 RET_LIST))
(mode_tile "x_point" 0)
(mode_tile "y_point" 0)
(mode_tile "z_point" 0)
(set_tile "x_point" (rtos (car POINT_3D) 2 16))
(set_tile "y_point" (rtos (cadr POINT_3D) 2 16))
(set_tile "z_point" (rtos (caddr POINT_3D) 2 16))
(action_tile
"x_point"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (list FLAG (atof $value) (nth 1 POINT_3D) (nth 2 POINT_3D)))"
)
(action_tile
"y_point"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (list FLAG (nth 0 POINT_3D) (atof $value) (nth 2 POINT_3D)))"
)
(action_tile
"z_point"
"(mode_tile \"go_subst\" 0)
(setq NEW_ITEM (list FLAG (nth 0 POINT_3D) (nth 1 POINT_3D) (atof $value)))"
)
)
((setq BITS_FLAG (nth 4 RET_LIST))
(setq
BITS_VALUE (car BITS_FLAG)
OLD_BITS_VALUE BITS_VALUE
BITS_RANGE (cadr BITS_FLAG)
TILES_NAME (list "bit_128" "bit_64" "bit_32" "bit_16" "bit_8" "bit_4" "bit_2" "bit_1")
TILES_VALUE (list 128 64 32 16 8 4 2 1)
COUNTER 0
)
(while (setq TILE_NAME (nth COUNTER TILES_NAME))
(setq TILE_VALUE (nth COUNTER TILES_VALUE))
(if (member TILE_VALUE BITS_RANGE)
(progn
(mode_tile TILE_NAME 0)
(if (>= BITS_VALUE TILE_VALUE)
(progn
(setq BITS_VALUE (- BITS_VALUE TILE_VALUE))
(set_tile TILE_NAME "1")
)
(set_tile TILE_NAME "0")
)
)
)
(setq COUNTER (1+ COUNTER))
)
(defun CALCULATE_BITS_SUM ( / BITS_SUM COUNTER TILE_NAME TILE_VALUE )
(setq
BITS_SUM 0
COUNTER 0
)
(while (setq TILE_NAME (nth COUNTER TILES_NAME))
(setq TILE_VALUE (nth COUNTER TILES_VALUE))
(if (member TILE_VALUE (cadr BITS_FLAG))
(if (= (get_tile TILE_NAME) "1")
(setq BITS_SUM (+ BITS_SUM TILE_VALUE))
)
)
(setq COUNTER (1+ COUNTER))
)
(eval BITS_SUM)
)
(setq COUNTER 0)
(while (setq TILE_NAME (nth COUNTER TILES_NAME))
(action_tile
TILE_NAME
"(mode_tile \"go_subst\" 0) (setq NEW_ITEM (cons FLAG (calculate_bits_sum)))"
)
(setq COUNTER (1+ COUNTER))
)
)
)
)
(defun GO_SUBST ()
(setq ENT_LIST (subst NEW_ITEM SELECTED_ITEM ENT_LIST))
(entmod ENT_LIST)
)
(defun TILES_ONOFF ()
(if NEXT_ENT
(mode_tile "next_ent" 0)
(mode_tile "next_ent" 1)
)
)
(setq OLD_CMDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq LEVEL_FLAG "0")
(setq WHAT_NEXT 4)
(setq DCL_ID (load_dialog "dxf.dcl"))
(while (> WHAT_NEXT 1)
(if (not (new_dialog "dxf_main" DCL_ID)) (exit))
(set_tile "level" LEVEL_FLAG)
(action_tile "level" "(setq LEVEL_FLAG $value)")
(action_tile "pick_ent" "(done_dialog 2)")
(if ENT_LIST
(show_list)
)
(action_tile "next_ent" "(show_next_ent) (tiles_onoff)")
(action_tile "output_list" "(show_features (atoi $value))")
(action_tile "go_subst" "(done_dialog 3)")
(action_tile "accept" "(done_dialog 1)")
(reset_values)
(tiles_onoff)
(setq WHAT_NEXT (start_dialog))
(if (= WHAT_NEXT 2)
(pick_ent)
)
(if (= WHAT_NEXT 3)
(go_subst)
)
)
(setq *error* OLD_ERROR)
(if (> (getvar "UNDOCTL") 3)
(command "_.Undo" "_End")
)
(setvar "CMDECHO" OLD_CMDECHO)
(princ)
)
(princ "DXF加载.")
(princ)

(defun C:DXF 
  ( 
      / 
      DCL_ID            ERRMSG            PICK_ENT          TILES_ONOFF 
      DXF_ERROR         NEXT_ENT          SHOW_LIST         WHAT_NEXT 
      ENT_LIST          OLD_CMDECHO       SHOW_NEXT_ENT     OUTPUT_LIST 
      LIST_POINTER      NEW_ITEM          SHOW_FEATURES     ENTITY_TYPE 
      GET_FEATURES      RESET_VALUES      FLAG              SELECTED_ITEM 
      RANGE_LISTS       POINT_3D          EDITBOX_VALUE     BITS_FLAG 
      CALCULATE_BITS_SUM 
      TILES_NAME        TILES_VALUE 
  ) 
 
  (defun DXF_ERROR ( ERRMSG ) 
      (if 
         (and 
            (/= ERRMSG "功能取消") 
            (/= ERRMSG "退出程序") 
         ) 
         (princ (strcat "\nDXF应用程序错误: " ERRMSG "\n")) 
      ) 
 
      (setvar "CMDECHO" OLD_CMDECHO) 
      (setq *error* OLD_ERROR) 
 
      (setq 
         DCL_ID             nil NEXT_ENT           nil SHOW_NEXT_ENT      nil 
         DXF_ERROR          nil OLD_CMDECHO        nil TILES_ONOFF        nil 
         ENT_LIST           nil PICK_ENT           nil WHAT_NEXT          nil 
         ERRMSG             nil SHOW_LIST          nil OUTPUT_LIST        nil 
         LIST_POINTER       nil 
      ) 
      (princ) 
   ) 
 
   (defun GET_FEATURES 
      ( 
         ENTITY_TYPE FLAG SUBCLASS 
         / 
         ENT DIMSTYLE_LIST GETDIMSTYLE GETLAYER LAYERS_LIST 
         TXTSTYLE_LIST GETTXTSTYLE 
      ) 
 
      (setq GETLAYER (cdr (assoc 2 (tblnext "LAYER" T)))) 
      (while GETLAYER 
         (setq LAYERS_LIST (append LAYERS_LIST (list GETLAYER))) 
         (setq GETLAYER (cdr (assoc 2 (tblnext "LAYER")))) 
      ) 
      (setq LAYERS_LIST (acad_strlsort LAYERS_LIST)) 
 
      (setq GETTXTSTYLE (cdr (assoc 2 (tblnext "STYLE" T)))) 
      (while GETTXTSTYLE 
         (setq TXTSTYLE_LIST (append TXTSTYLE_LIST (list GETTXTSTYLE))) 
         (setq GETTXTSTYLE (cdr (assoc 2 (tblnext "STYLE")))) 
      ) 
      (setq DIMSTYLE_LIST (acad_strlsort TXTSTYLE_LIST)) 
 
      (setq GETDIMSTYLE (cdr (assoc 2 (tblnext "DIMSTYLE" T)))) 
      (while GETDIMSTYLE 
         (setq DIMSTYLE_LIST (append DIMSTYLE_LIST (list GETDIMSTYLE))) 
         (setq GETDIMSTYLE (cdr (assoc 2 (tblnext "DIMSTYLE")))) 
      ) 
      (setq DIMSTYLE_LIST (acad_strlsort DIMSTYLE_LIST)) 
 
      (cond 
         ((= FLAG -1) 
            (list 
               (list "图元名") 
               nil nil nil nil 
            ) 
         ) 
         ((= FLAG 0) (list (list "图元类型") nil nil nil nil)) 
         ((= FLAG 5) (list (list "图元句柄") nil nil nil nil)) 
         ((= FLAG 102) 
            (list 
               (list "供应用程序使用的控制字符串") 
               nil nil nil nil 
            ) 
         ) 
         ((= FLAG 100) (list (list "子类数据标记") nil nil nil nil)) 
         ((= FLAG 67) 
            (list 
               (list "模型空间/图纸空间") 
               (list 
                  (list 0 1) 
                  (list 
                     "0\t模型空间" 
                     "1\t图纸空间" 
                  ) 
               ) 
               nil nil nil 
            ) 
         ) 
         ((= FLAG 8) 
            (list (list "图层名") (list LAYERS_LIST LAYERS_LIST) nil nil nil) 
         ) 
         ((= FLAG 6) 
            (list 
               (list 
                  "线型名(随层)." 
                  "线型名(随块)." 
               ) 
               nil (cdr (assoc FLAG ENT_LIST)) nil nil 
            ) 
         ) 
         ((= FLAG 62) 
            (list 
               (list 
                  "颜色号 0 = 随块.256 = 随层." 
                  "负值表示层关闭. 禁止(选项)." 
               ) 
               nil (cdr (assoc FLAG ENT_LIST)) nil nil 
            ) 
         ) 
         ((= FLAG 48) 
            (list 
               (list "线型比例(选项)") 
               nil (cdr (assoc FLAG ENT_LIST)) nil nil 
            ) 
         ) 
         ((= FLAG 60) 
            (list 
               (list "可见性(选项)") 
               (list (list 0 1) (list "0\t可见" "1\t不可见")) nil nil nil 
            ) 
         ) 
 
         ((= ENTITY_TYPE "CIRCLE") 
            (cond 
               ((= FLAG 39) 
                  (list 
                     (list "厚度 (选项; 缺省 = 0)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 10) 
                  (list 
                     (list "中心点 (OCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 40) (list (list "半径") nil (cdr (assoc FLAG ENT_LIST)) nil nil)) 
               ((= FLAG 210) 
                  (list 
                     (list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               (T (list nil nil nil nil nil)) 
            ) 
         ) 
 
         ((= ENTITY_TYPE "DIMENSION") 
            (cond 
               ((= FLAG 2) 
                  (list 
                     (list "包含构成标注图片的图元的块的名称") 
                     nil nil nil nil 
                  ) 
               ) 
               ((= FLAG 10) 
                  (list 
                     (list "定义点(WCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 11) 
                  (list 
                     (list "标注文字的中点(OCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 70) 
                  (list 
                     (list "标注类型") 
                     nil nil nil (list (cdr (assoc FLAG ENT_LIST)) (list 32 64 128)) 
                  ) 
               ) 
               ((= FLAG 1) 
                  (list 
                     (list "由用户明确输入的标注文字") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 53) 
                  (list 
                     (list 
                        "标注文字与其默认方向所成的旋转角度" 
                        "(尺寸线方向)" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 51) 
                  (list 
                     (list 
                        "所有标注类型均有可选的51组码，表示标注图元的水平方向" 
                        "标注图元决定水平、垂直和旋转线性标注的标注文字和直线的方向" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 3) 
                  (list 
                     (list "标注样式名") 
                     (list DIMSTYLE_LIST DIMSTYLE_LIST) nil nil nil 
                  ) 
               ) 
               ((= FLAG 210) 
                  (list 
                     (list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
 
               ((and (= FLAG 12) (= SUBCLASS "AcDbAlignedDimension")) 
                  (list 
                     (list 
                        "标注克隆的插入点:" 
                        "基线和连续(OCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 13) (= SUBCLASS "AcDbAlignedDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点(WCS中): 3D点" 
                        "指定的第一个延长线的起点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 14) (= SUBCLASS "AcDbAlignedDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点(WCS中): 3D点" 
                        "指定的第二个延长线的起点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
 
               ((= FLAG 50) 
                  (list 
                     (list "转角标注、水平标注或垂直标注的角度") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 52) 
                  (list 
                     (list 
                        "带倾斜角的线性标注类型有可选组码 52。" 
      "当添加到线性标注的旋转角度(组码 50)时，将给出尺寸界线的角度" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
 
               ( 
                  (and 
                     (= FLAG 15) 
                     (member SUBCLASS (list "AcDbRadialDimension" "AcDbDiametricDimension")) 
                  ) 
                  (list 
                     (list 
                        "直径标注、半径标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ( 
                  (and 
                     (= FLAG 40) 
                     (member SUBCLASS (list "AcDbRadialDimension" "AcDbDiametricDimension")) 
                  ) 
                  (list 
                     (list "半径标注和直径标注的引线长度") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
 
               ((and (= FLAG 13) (= SUBCLASS "AcDb3PointAngularDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 14) (= SUBCLASS "AcDb3PointAngularDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 15) (= SUBCLASS "AcDb3PointAngularDimension")) 
                  (list 
                     (list 
                        "直径标注、半径标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 16) (= SUBCLASS "AcDb3PointAngularDimension")) 
                  (list 
                     (list 
                        "定义角度标注的标注圆弧的点" 
                        "(OCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
 
               ((and (= FLAG 13) (= SUBCLASS "AcDbOrdinateDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((and (= FLAG 14) (= SUBCLASS "AcDbOrdinateDimension")) 
                  (list 
                     (list 
                        "线性标注和角度标注的定义点" 
                        "(WCS中): 3D点" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
 
               (T (list nil nil nil nil nil)) 
            ) 
         ) 
 
         ((= ENTITY_TYPE "LINE") 
            (cond 
               ((= FLAG 39) 
                  (list 
                     (list "厚度(选项; 缺省 = 0)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 10) 
                  (list 
                     (list "起点(WCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 11) 
                  (list 
                     (list "终点(WCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 210) 
                  (list 
                     (list 
                        "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               (T (list nil nil nil nil nil)) 
            ) 
         ) 
 
         ((= ENTITY_TYPE "MTEXT") 
            (cond 
               ((= FLAG 10) 
                  (list 
                     (list "插入点 DXF: 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 40) 
                  (list (list "缺省文字高度") 
                  nil (cdr (assoc FLAG ENT_LIST)) nil) 
               ) 
               ((= FLAG 41) 
                  (list 
                     (list "参照矩形宽度") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 71) 
                  (list 
                     (list "附着点") 
                     (list 
                        (list 1 2 3 4 5 6 7 8 9) 
                        (list 
                           "1\t左上" 
                           "2\t中上" 
                           "3\t右上" 
                           "4\t左中" 
                           "5\t正中" 
                           "6\t右中" 
                           "7\t左下" 
                           "8\t中下" 
                           "9\t右下a" 
                        ) 
                     ) 
                     nil nil nil 
                  ) 
               ) 
               ((= FLAG 72) 
                  (list 
                     (list "图形方向") 
                     (list 
                        (list 1 2 3 4) 
                        (list 
                           "1\t从左至右" 
                           "2\t从右至左" 
                           "3\t从上到下" 
                           "4\t从下到上" 
         "5\t随式样" 
                        ) 
                     ) 
                     nil nil nil 
                  ) 
               ) 
               ((= FLAG 1) 
                  (list 
                     (list 
                        "字符串。如果字符串长度小于250个字符，所有字符均出现在组1中。" 
      "如果字符串长度大于250个字符，该字符串将分成长度为250个字符的数据块" 
      "并显示在一个或多个组3代码中。如果使用组3代码，最后一个组将是组1 且字符数少于250个" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 3) 
                  (list 
                     (list "附加文字(始终在长度为 250 个字符的数据块中).") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 7) 
                  (list 
                     (list "文字样式名(如果未提供，则为: STANDARD)") 
                     (list TXTSTYLE_LIST TXTSTYLE_LIST) nil nil nil 
                  ) 
               ) 
               ((= FLAG 210) 
                  (list 
                     (list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 11) 
                  (list 
                     (list "方向矢量(WCS中): 3D矢量.") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 42) 
                  (list 
                     (list 
                        "构成多行文字图元的字符的水平宽度" 
      "该值始终等于或小于组码41的值" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 43) 
                  (list 
                     (list "多行文字图元的垂直高度") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 50) 
                  (list 
                     (list "以弧度为单位的旋转角度") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               (T (list nil nil nil nil nil)) 
            ) 
         ) 
 
         ((= ENTITY_TYPE "TEXT") 
            (cond 
               ((= FLAG 39) 
                  (list 
                     (list "厚度(选项; 缺省 = 0)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 10) 
                  (list 
                     (list "第一对齐点(OCS中): 3D点") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 40) (list (list "文字高度") nil (cdr (assoc FLAG ENT_LIST)) nil)) 
               ((= FLAG 1) 
                  (list 
                     (list "默认值(字符串本身)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 50) 
                  (list 
                     (list "文字旋转角度(选项, 缺省 = 0)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 41) 
                  (list 
                     (list 
                        "相对X缩放比例: 宽度(选项; 缺省 = 1)." 
                        "使用拟合类型的文字时, 该值也将进行调整" 
                     ) 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 51) 
                  (list 
                     (list "倾斜角(选项, 缺省 = 0)") 
                     nil (cdr (assoc FLAG ENT_LIST)) nil nil 
                  ) 
               ) 
               ((= FLAG 7) 
                  (list 
                     (list "文字样式名(选项, 缺省 = STANDARD)") 
                     (list TXTSTYLE_LIST TXTSTYLE_LIST) nil nil nil 
                  ) 
               ) 
               ((= FLAG 71) 
                  (list 
                     (list 
                        "文字生成标志(选项, 缺省 = 0)" 
                        "2 = 文字反向(在X轴方向镜像), 4 = 文字倒置(在Y轴方向镜像)" 
                     ) 
                     nil nil nil (list (cdr (assoc FLAG ENT_LIST)) (list 2 4)) 
                  ) 
               ) 
               ((= FLAG 72) 
                  (list 
                     (list 
                        "文字水平对正类型(选项, 缺省 = 0)" 
                        "整数代码(非按位编码)" 
                     ) 
                     (list 
                        (list 0 1 2 3 4 5) 
                        (list 
                           "0\t左对正" 
                           "1\t居中对正" 
                           "2\t右对正" 
                           "3\t对齐(如果垂直对齐 = 0)" 
                           "4\t中间(如果垂直对齐 = 0)" 
                           "5\t拟合(如果垂直对齐 = 0)" 
                        ) 
                     ) 
                     nil nil nil 
                  ) 
               ) 
               ((= FLAG 11) 
                  (list 
                     (list 
                        "第二对齐点(OCS中): 3D点. 只有当72或73组的值非零时，该值才有意义" 
                        "(如果对正不是基线对正/左对正)" 
                     ) 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 210) 
                  (list 
                     (list "拉伸方向(选项; 缺省 = 0, 0, 1): 3D矢量") 
                     nil nil (cdr (assoc FLAG ENT_LIST)) nil 
                  ) 
               ) 
               ((= FLAG 73) 
                  (list 
                     (list 
                        "文字垂直对正类型(选项, 缺省 = 0)" 
                        "整数代码(不是按位编码)" 
                     ) 
                     (list 
                        (list 0 1 2 3) 
                        (list 
                           "0\t基线对正" 
                           "1\t底端对正" 
                           "2\t居中对正" 
                           "3\t顶端对正" 
                        ) 
                     ) 
                     nil nil nil 
                  ) 
               ) 
               (T (list nil nil nil nil nil)) 
            ) 
         ) 
 
         (T (list nil nil nil nil nil)) 
      ) 
   ) 
 
   (defun PICK_ENT ( / ENT ) 
      (if (= LEVEL_FLAG "0") 
         (setq ENT (entsel)) 
         (setq ENT (nentsel)) 
      ) 
      (if (null ENT) 
         (progn 
            (alert "没有实体选择") 
            (setq NEXT_ENT nil) 
         ) 
         (progn 
            (setq NEXT_ENT (entnext (car ENT))) 
            (setq ENT_LIST (entget (car ENT))) 
         ) 
      ) 
   ) 
 
  (setq ACADLIBTEMP "C:\\Documents and Settings\\Administrator\\Application Data") 
 
   (defun SHOW_LIST ( / FHANDLE ITEM POINTER ) 
      (setq FHANDLE (open (strcat ACADLIBTEMP "/DXF.TXT") "w")) 
      (setq POINTER 0) 
      (while (setq ITEM (nth POINTER ENT_LIST)) 
         (prin1 ITEM FHANDLE) 
         (write-line "" FHANDLE) 
         (setq POINTER (1+ POINTER)) 
      ) 
      (close FHANDLE) 
      (setq FHANDLE (open (strcat ACADLIBTEMP "/DXF.TXT") "r")) 
      (setq OUTPUT_LIST nil) 
      (while (setq ITEM (read-line FHANDLE)) 
         (setq OUTPUT_LIST (append OUTPUT_LIST (list item))) 
      ) 
      (close FHANDLE) 
 
      (start_list "output_list") 
      (mapcar 'add_list OUTPUT_LIST) 
      (end_list) 
 
      (setq ENTITY_TYPE (cdr (assoc 0 ENT_LIST))) 
      (set_tile "entity_type" ENTITY_TYPE) 
      (set_tile "flag" "") 
      (set_tile "subclass_type" "") 
      (set_tile "flag_descr_01" "") 
      (set_tile "flag_descr_02" "") 
   ) 
 
   (defun SHOW_NEXT_ENT () 
      (setq 
         ENT NEXT_ENT 
         ENT_LIST (entget ENT) 
         NEXT_ENT (entnext ENT) 
      ) 
      (show_list) 
      (reset_values) 
   ) 
 
   (defun RESET_VALUES () 
      (start_list "popup_value") 
      (end_list) 
      (set_tile "editbox_value" "") 
      (set_tile "x_point" "") 
      (set_tile "y_point" "") 
      (set_tile "z_point" "") 
      (mode_tile "popup_value" 1) 
      (mode_tile "editbox_value" 1) 
      (mode_tile "x_point" 1) 
      (mode_tile "y_point" 1) 
      (mode_tile "z_point" 1) 
      (mode_tile "go_subst" 1) 
      (mode_tile "bit_1" 1) 
      (mode_tile "bit_2" 1) 
      (mode_tile "bit_4" 1) 
      (mode_tile "bit_8" 1) 
      (mode_tile "bit_16" 1) 
      (mode_tile "bit_32" 1) 
      (mode_tile "bit_64" 1) 
      (mode_tile "bit_128" 1) 
   ) 
 
   (defun SHOW_FEATURES 
      ( 
         LIST_POINTER 
         / 
         DESCR_01 DESCR_02 ITEM POINTER RET_LIST SUBCLASS BITS_VALUE BITS_RANGE 
         COUNTER TILE_NAME TILE_VALUE OLD_BITS_VALUE 
      ) 
 
      (setq POINTER LIST_POINTER) 
      (while (and (> POINTER 0) (null SUBCLASS)) 
         (setq ITEM (nth POINTER ENT_LIST)) 
         (if (= (car ITEM) 100) 
            (setq SUBCLASS (cdr ITEM)) 
         ) 
         (setq POINTER (1- POINTER)) 
      ) 
 
      (setq 
         SELECTED_ITEM (nth LIST_POINTER ENT_LIST) 
         FLAG (car SELECTED_ITEM) 
         RET_LIST (get_features ENTITY_TYPE FLAG SUBCLASS) 
         DESCR_01 (car (nth 0 RET_LIST)) 
         DESCR_02 (cadr (nth 0 RET_LIST)) 
      ) 
 
      (set_tile "flag" (itoa FLAG)) 
      (if SUBCLASS 
         (set_tile "subclass_type" SUBCLASS) 
         (set_tile "subclass_type" "") 
      ) 
      (if DESCR_01 
         (set_tile "flag_descr_01" DESCR_01) 
         (set_tile "flag_descr_01" "") 
      ) 
      (if DESCR_02 
         (set_tile "flag_descr_02" DESCR_02) 
         (set_tile "flag_descr_02" "") 
      ) 
 
      (reset_values) 
      (cond 
         ((setq RANGE_LISTS (nth 1 RET_LIST)) 
            (start_list "popup_value") 
            (mapcar 'add_list (cadr RANGE_LISTS)) 
            (end_list) 
            (mode_tile "popup_value" 0) 
            (set_tile 
               "popup_value" 
               (itoa 
                  (- 
                     (length (car RANGE_LISTS)) 
                     (length (member (cdr SELECTED_ITEM) (car RANGE_LISTS))) 
                  ) 
               ) 
            ) 
            (action_tile 
               "popup_value" 
               "(mode_tile \"go_subst\" 0) 
                (setq NEW_ITEM (cons FLAG (nth (atoi $value) (car RANGE_LISTS))))" 
            ) 
         ) 
 
         ((setq EDITBOX_VALUE (nth 2 RET_LIST)) 
            (mode_tile "editbox_value" 0) 
            (cond 
               ((= (type EDITBOX_VALUE) 'STR) 
                  (progn 
                     (set_tile "editbox_value" EDITBOX_VALUE) 
                     (action_tile 
                        "editbox_value" 
                        "(mode_tile \"go_subst\" 0) 
                         (setq NEW_ITEM (cons FLAG $value))" 
                     ) 
                  ) 
               ) 
               ((= (type EDITBOX_VALUE) 'INT) 
                  (progn 
                     (set_tile "editbox_value" (itoa EDITBOX_VALUE)) 
                     (action_tile 
                        "editbox_value" 
                        "(mode_tile \"go_subst\" 0) 
                         (setq NEW_ITEM (cons FLAG (atoi $value)))" 
                     ) 
                  ) 
               ) 
               ((= (type EDITBOX_VALUE) 'REAL) 
                  (progn 
                     (set_tile "editbox_value" (rtos EDITBOX_VALUE 2 16)) 
                     (action_tile 
                        "editbox_value" 
                        "(mode_tile \"go_subst\" 0) 
                         (setq NEW_ITEM (cons FLAG (atof $value)))" 
                     ) 
                  ) 
               ) 
            ) 
         ) 
 
         ((setq POINT_3D (nth 3 RET_LIST)) 
            (mode_tile "x_point" 0) 
            (mode_tile "y_point" 0) 
            (mode_tile "z_point" 0) 
            (set_tile "x_point" (rtos (car POINT_3D) 2 16)) 
            (set_tile "y_point" (rtos (cadr POINT_3D) 2 16)) 
            (set_tile "z_point" (rtos (caddr POINT_3D) 2 16)) 
            (action_tile 
               "x_point" 
               "(mode_tile \"go_subst\" 0) 
                (setq NEW_ITEM (list FLAG (atof $value) (nth 1 POINT_3D) (nth 2 POINT_3D)))" 
            ) 
            (action_tile 
               "y_point" 
               "(mode_tile \"go_subst\" 0) 
                (setq NEW_ITEM (list FLAG (nth 0 POINT_3D) (atof $value) (nth 2 POINT_3D)))" 
            ) 
            (action_tile 
               "z_point" 
               "(mode_tile \"go_subst\" 0) 
                (setq NEW_ITEM (list FLAG (nth 0 POINT_3D) (nth 1 POINT_3D) (atof $value)))" 
            ) 
         ) 
 
         ((setq BITS_FLAG (nth 4 RET_LIST)) 
            (setq 
               BITS_VALUE (car BITS_FLAG) 
               OLD_BITS_VALUE BITS_VALUE 
               BITS_RANGE (cadr BITS_FLAG) 
               TILES_NAME (list "bit_128" "bit_64" "bit_32" "bit_16" "bit_8" "bit_4" "bit_2" "bit_1") 
               TILES_VALUE (list 128 64 32 16 8 4 2 1) 
               COUNTER 0 
            ) 
            (while (setq TILE_NAME (nth COUNTER TILES_NAME)) 
               (setq TILE_VALUE (nth COUNTER TILES_VALUE)) 
               (if (member TILE_VALUE BITS_RANGE) 
                  (progn 
                     (mode_tile TILE_NAME 0) 
                     (if (>= BITS_VALUE TILE_VALUE) 
                        (progn 
                           (setq BITS_VALUE (- BITS_VALUE TILE_VALUE)) 
                           (set_tile TILE_NAME "1") 
                        ) 
                        (set_tile TILE_NAME "0") 
                     ) 
                  ) 
               ) 
               (setq COUNTER (1+ COUNTER)) 
            ) 
 
            (defun CALCULATE_BITS_SUM ( / BITS_SUM COUNTER TILE_NAME TILE_VALUE ) 
               (setq 
                  BITS_SUM 0 
                  COUNTER 0 
               ) 
               (while (setq TILE_NAME (nth COUNTER TILES_NAME)) 
                  (setq TILE_VALUE (nth COUNTER TILES_VALUE)) 
                  (if (member TILE_VALUE (cadr BITS_FLAG)) 
                     (if (= (get_tile TILE_NAME) "1") 
                        (setq BITS_SUM (+ BITS_SUM TILE_VALUE)) 
                     ) 
                  ) 
                  (setq COUNTER (1+ COUNTER)) 
               ) 
               (eval BITS_SUM) 
            ) 
 
            (setq COUNTER 0) 
            (while (setq TILE_NAME (nth COUNTER TILES_NAME)) 
               (action_tile 
                  TILE_NAME 
                  "(mode_tile \"go_subst\" 0) (setq NEW_ITEM (cons FLAG (calculate_bits_sum)))" 
               ) 
               (setq COUNTER (1+ COUNTER)) 
            ) 
         ) 
      ) 
   ) 
 
   (defun GO_SUBST () 
      (setq ENT_LIST (subst NEW_ITEM SELECTED_ITEM ENT_LIST)) 
      (entmod ENT_LIST) 
   ) 
 
   (defun TILES_ONOFF () 
      (if NEXT_ENT 
         (mode_tile "next_ent" 0) 
         (mode_tile "next_ent" 1) 
      ) 
   ) 
 
  (setq OLD_CMDECHO (getvar "CMDECHO")) 
   (setvar "CMDECHO" 0) 
 
   (setq LEVEL_FLAG "0") 
 
   (setq WHAT_NEXT 4) 
   (setq DCL_ID (load_dialog "dxf.dcl")) 
   (while (> WHAT_NEXT 1) 
      (if (not (new_dialog "dxf_main" DCL_ID)) (exit)) 
 
      (set_tile "level" LEVEL_FLAG) 
      (action_tile "level" "(setq LEVEL_FLAG $value)") 
 
      (action_tile "pick_ent" "(done_dialog 2)") 
 
      (if ENT_LIST 
         (show_list) 
      ) 
 
      (action_tile "next_ent" "(show_next_ent) (tiles_onoff)") 
 
      (action_tile "output_list" "(show_features (atoi $value))") 
 
      (action_tile "go_subst" "(done_dialog 3)") 
 
      (action_tile "accept" "(done_dialog 1)") 
 
      (reset_values) 
      (tiles_onoff) 
 
      (setq WHAT_NEXT (start_dialog)) 
      (if (= WHAT_NEXT 2) 
         (pick_ent) 
      ) 
      (if (= WHAT_NEXT 3) 
        (go_subst) 
      ) 
   ) 
 
   (setq *error* OLD_ERROR) 
   (if (> (getvar "UNDOCTL") 3) 
      (command "_.Undo" "_End") 
   ) 
   (setvar "CMDECHO" OLD_CMDECHO) 
   (princ) 
) 
 
(princ "DXF加载.") 
(princ)

dcl_settings :default_dcl_settings
{
audit_level = 0;
}
dxf_main :dialog
{
label = "DXF组码提取";
:row
{
:column
{
:list_box
{
label = "输出屏";
key = "output_list";
width = 45;
height = 35;
}
}
:column
{
:row
{
:popup_list
{
label = "层次:";
mnemonic = "L";
key = "level";
list = "ENTSEL(直接实体)\nNENTSEL(嵌套实体)";
edit_width = 25;
}
:button
{
label = "选取实体 <";
mnemonic = "P";
key = "pick_ent";
}
:button
{
label = "下一实体";
mnemonic = "N";
key = "next_ent";
}
}
:row
{
:row
{
fixed_width = true;
:boxed_row
{
label = "实体";
:text
{
key = "entity_type";
width = 12;
}
}
:boxed_row
{
label = "标记";
:text
{
key = "flag";
width = 4;
}
}
:boxed_row
{
label = "子类";
:text
{
key = "subclass_type";
width = 25;
}
}
}
:button
{
label = "替换";
mnemonic = "S";
key = "go_subst";
}
}
:boxed_column
{
label = "描述";
:text
{
key = "flag_descr_01";
}
:text
{
key = "flag_descr_02";
}
}
:boxed_column
{
label = "替换";
:popup_list
{
label = "值:";
mnemonic = "V";
key = "popup_value";
tabs = "5";
edit_width = 63;
}
:edit_box
{
label = "值:";
mnemonic = "V";
key = "editbox_value";
edit_width = 63;
}
:row
{
:edit_box
{
label = "X:";
mnemonic = "X";
key = "x_point";
width = 18;
edit_width = 16;
fixed_width = true;
}
:edit_box
{
label = "Y:";
mnemonic = "Y";
key = "y_point";
width = 18;
edit_width = 16;
fixed_width = true;
}
:edit_box
{
label = "Z:";
mnemonic = "Z";
key = "z_point";
width = 18;
edit_width = 16;
fixed_width = true;
}
}
:row
{
:text
{
label = "位:";
}
:toggle
{
label = "1";
mnemonic = "1";
key = "bit_1";
}
:toggle
{
label = "2";
mnemonic = "2";
key = "bit_2";
}
:toggle
{
label = "4";
mnemonic = "4";
key = "bit_4";
}
:toggle
{
label = "8";
mnemonic = "8";
key = "bit_8";
}
:toggle
{
label = "16";
mnemonic = "16";
key = "bit_16";
}
:toggle
{
label = "32";
mnemonic = "32";
key = "bit_32";
}
:toggle
{
label = "64";
mnemonic = "64";
key = "bit_64";
}
:toggle
{
label = "128";
mnemonic = "128";
key = "bit_128";
}
}
}
:space
{
height = 5;
}
}
}
spacer;
:row
{
fixed_width = true;
alignment = centered;
:button
{
label = "关闭";
mnemonic = "C";
key = "cancel";
width = 8;
is_cancel = true;
}
}
}

dcl_settings :default_dcl_settings 
{ 
  audit_level = 0; 
} 
 
dxf_main :dialog 
{ 
  label = "DXF组码提取"; 
  :row 
  { 
    :column 
    { 
      :list_box 
      { 
        label           = "输出屏"; 
        key             = "output_list"; 
        width           = 45; 
        height          = 35; 
      } 
    } 
    :column 
    { 
      :row 
      { 
        :popup_list 
        { 
          label         = "层次:"; 
          mnemonic      = "L"; 
          key           = "level"; 
          list          = "ENTSEL(直接实体)\nNENTSEL(嵌套实体)"; 
          edit_width    = 25; 
        } 
        :button 
        { 
          label         = "选取实体 <"; 
          mnemonic      = "P"; 
          key           = "pick_ent"; 
        } 
        :button 
        { 
          label         = "下一实体"; 
          mnemonic      = "N"; 
          key           = "next_ent"; 
        } 
      } 
      :row 
      { 
        :row 
        { 
          fixed_width   = true; 
          :boxed_row 
          { 
            label       = "实体"; 
            :text 
            { 
              key       = "entity_type"; 
              width     = 12; 
            } 
          } 
          :boxed_row 
          { 
            label       = "标记"; 
            :text 
            { 
              key       = "flag"; 
              width     = 4; 
            } 
          } 
          :boxed_row 
          { 
            label       = "子类"; 
            :text 
            { 
              key       = "subclass_type"; 
              width     = 25; 
            } 
          } 
        } 
        :button 
        { 
          label         = "替换"; 
          mnemonic      = "S"; 
          key           = "go_subst"; 
        } 
      } 
      :boxed_column 
      { 
        label           = "描述"; 
        :text 
        { 
          key           = "flag_descr_01"; 
        } 
        :text 
        { 
          key           = "flag_descr_02"; 
        } 
      } 
      :boxed_column 
      { 
        label           = "替换"; 
        :popup_list 
        { 
          label         = "值:"; 
          mnemonic      = "V"; 
          key           = "popup_value"; 
          tabs          = "5"; 
          edit_width    = 63; 
        } 
        :edit_box 
        { 
          label         = "值:"; 
          mnemonic      = "V"; 
          key           = "editbox_value"; 
          edit_width    = 63; 
        } 
        :row 
        { 
          :edit_box 
          { 
            label       = "X:"; 
            mnemonic    = "X"; 
            key         = "x_point"; 
            width       = 18; 
            edit_width  = 16; 
            fixed_width = true; 
          } 
          :edit_box 
          { 
            label       = "Y:"; 
            mnemonic    = "Y"; 
            key         = "y_point"; 
            width       = 18; 
            edit_width  = 16; 
            fixed_width = true; 
          } 
          :edit_box 
          { 
            label       = "Z:"; 
            mnemonic    = "Z"; 
            key         = "z_point"; 
            width       = 18; 
            edit_width  = 16; 
            fixed_width = true; 
          } 
        } 
        :row 
        { 
          :text 
          { 
            label       = "位:"; 
          } 
          :toggle 
          { 
            label       = "1"; 
            mnemonic    = "1"; 
            key         = "bit_1"; 
          } 
          :toggle 
          { 
            label       = "2"; 
            mnemonic    = "2"; 
            key         = "bit_2"; 
          } 
          :toggle 
          { 
            label       = "4"; 
            mnemonic    = "4"; 
            key         = "bit_4"; 
          } 
          :toggle 
          { 
            label       = "8"; 
            mnemonic    = "8"; 
            key         = "bit_8"; 
          } 
          :toggle 
          { 
            label       = "16"; 
            mnemonic    = "16"; 
            key         = "bit_16"; 
          } 
          :toggle 
          { 
            label       = "32"; 
            mnemonic    = "32"; 
            key         = "bit_32"; 
          } 
          :toggle 
          { 
            label       = "64"; 
            mnemonic    = "64"; 
            key         = "bit_64"; 
          } 
          :toggle 
          { 
            label       = "128"; 
            mnemonic    = "128"; 
            key         = "bit_128"; 
          } 
        } 
      } 
      :space 
      { 
        height = 5; 
      } 
    } 
  } 
  spacer; 
  :row 
  { 
    fixed_width         = true; 
    alignment           = centered; 
    :button 
    { 
      label             = "关闭"; 
      mnemonic          = "C"; 
      key               = "cancel"; 
      width             = 8; 
      is_cancel         = true; 
    } 
  } 
}

sachindkini · 发表于 2023-2-28 20:19:11

Command: dxf
Select object: ; error: bad argument type: FILE nil

复制代码

fn2398 · 发表于 2018-8-19 12:48:04

代码好长看得晕乎，支持感谢楼主分享！

LLXXZZ · 发表于 2011-9-5 22:37:08

必须支持.....

xshrimp · 发表于 2011-9-5 23:05:20

设置一下ACADLIBTEMP路径如
(setq ACADLIBTEMP "C:")

yjr111 · 发表于 2011-9-6 00:34:26

好长的代码，晕~~~~

gbhsu · 发表于 2011-9-6 00:37:13

ding yi xia
zai kan

cabinsummer · 发表于 2011-9-6 06:24:37

xshrimp 发表于 2011-9-5 23:05
设置一下ACADLIBTEMP路径如
(setq ACADLIBTEMP "C:")

谢谢！我已经加上了。这是一个庞大的软件中的一个程序，调用了初始化的ACADLIBTEMP。这个值本来设置在注册表中，我现在把它提取出来，见程序中第624行。(setq ACADLIBTEMP "C:\\Documents and Settings\\Administrator\\Application Data")

qjcpj · 发表于 2011-9-6 08:36:57

选择对象: ; 错误: 参数类型错误: FILE nil
？？

cabinsummer · 发表于 2011-9-6 20:39:14

qjcpj 发表于 2011-9-6 08:36
选择对象: ; 错误: 参数类型错误: FILE nil
？？

你选择了什么？

cuyongping · 发表于 2011-9-22 12:40:13

.
; 警告: 用作函数的局部变量: SHOW_LIST
; 警告: 用作函数的局部变量: RESET_VALUES
; 警告: 用作函数的局部变量: TILES_ONOFF
; 警告: 用作函数的局部变量: PICK_ENT

skynoon · 发表于 2011-9-22 12:52:45

严重支持

账号		自动登录	找回密码
密码			注册

[【风之影】] [源码]提取DXF组码

评分

本帖被以下淘专辑推荐: