[源码]提取DXF组码
本帖最后由 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)
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;
}
}
}
Command: dxf
Select object: ; error: bad argument type: FILE nil 代码好长看得晕乎，支持感谢楼主分享！ 必须支持..... 设置一下ACADLIBTEMP路径如
(setq ACADLIBTEMP "C:") 好长的代码，晕~~~~ ding yi xia
zai kan xshrimp 发表于 2011-9-5 23:05 static/image/common/back.gif
设置一下ACADLIBTEMP路径如
(setq ACADLIBTEMP "C:")
谢谢！我已经加上了。这是一个庞大的软件中的一个程序，调用了初始化的ACADLIBTEMP。这个值本来设置在注册表中，我现在把它提取出来，见程序中第624行。(setq ACADLIBTEMP "C:\\Documents and Settings\\Administrator\\Application Data") 选择对象: ; 错误: 参数类型错误: FILE nil
？？ qjcpj 发表于 2011-9-6 08:36 static/image/common/back.gif
选择对象: ; 错误: 参数类型错误: FILE nil
？？
你选择了什么？ .
; 警告: 用作函数的局部变量: SHOW_LIST
; 警告: 用作函数的局部变量: RESET_VALUES
; 警告: 用作函数的局部变量: TILES_ONOFF
; 警告: 用作函数的局部变量: PICK_ENT 严重支持