已有 22 人购买 本主题需向作者支付 3 个明经币 才能浏览 购买主题
(defun c:ss (/ MAKE-DCL-SSS dclname LST1 EntType DXFLST DXFLST1 DXFLST2
DXFLST3 Dcl_Id return lst4 SS x y n
) ; 根据数据创建对话框文件
(defun MAKE-DCL-SSS (lst / tempname filen i n)
(setq dclname (cond
((setq tempname (vl-filename-mktemp "temp.dcl")
filen (open tempname "w")
)
(write-line "MY_SSS: dialog{ label = "快速选择 QQ181976640 ";"
filen
)
(write-line ":boxed_column{ label="过滤选项:";"
filen
)
(setq I 0)
(foreach N lst
(write-line (strcat ":toggle{
label="" (strcat (car N) " "
(vl-princ-to-string
(cdr N)
)
) "";
key = "KEY"(itoa I) "";
action="(do-addlst " (itoa I) ")";
value="0";
}"
) filen
)
(setq I (1+ I))
) ; end foreach
(write-line "}" filen)
(write-line "ok_cancel;" filen)
(write-line "}" filen)
(close filen)
tempname
)
)
)
)
(defun do-addlst (INT)
(if (= $VALUE "1") ; _表示被选中
(setq LST1 (cons INT LST1))
(setq LST1 (vl-remove INT LST1))
)
) ; ----------------------------------
(setq DXFLST1 (entget (car (entsel "\n点取源对象: ")))
EntType (cdr (assoc 0 DXFLST1))
)
(if (not (assoc 62 DXFLST1))
(setq DXFLST1 (append
DXFLST1
(list '(62 . 256))
)
)
)
(cond
((= EntType "ARC")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(10 "圆心坐标")
(40 "圆弧半径")
(50 "起点角度")
(51 "终点角度")
)
)
)
((= EntType "CIRCLE")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(10 "圆心坐标")
(40 "圆形半径")
)
)
)
((= EntType "SOLID")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
)
)
)
((= EntType "POINT")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(10 "点的位置")
)
)
)
((= EntType "LINE")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(10 "起点坐标")
(11 "终点坐标")
)
)
)
((= EntType "INSERT")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(2 "图块名称")
(10 "图块位置")
(41 "X 轴比例")
(42 "Y 轴比例")
(43 "Z 轴比例")
(50 "旋转角度")
)
)
)
((= EntType "LWPOLYLINE")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(70 "是否闭合")
)
)
)
((= EntType "POLYLINE")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(70 "是否闭合")
)
)
)
((= EntType "HATCH")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(2 "填充图案")
(41 "填充比例")
(52 "填充角度")
)
)
)
((= EntType "TEXT")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(1 "文字内容")
(7 "文字样式")
(10 "插入位置")
(40 "文字高度")
(41 "宽度系数")
(50 "旋转角度")
(51 "倾斜角度")
)
)
)
((= EntType "ATTDEF")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(2 "属性标记")
(7 "字型样式")
(10 "插入位置")
(40 "文字高度")
(50 "旋转角度")
(51 "倾斜角度")
)
)
)
((= EntType "MTEXT")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(10 "插入位置")
(1 "文字内容")
(7 "文字样式")
(40 "文字高度")
(50 "旋转角度")
)
)
)
((= EntType "DIMENSION")
(setq DXFLST '((0 "实体类型") (8 "所在图层")
(62 "实体颜色")
(1 "标注文字")
(42 "测量值")
(3 "标注样式")
)
)
)
(t
(alert "不支持的类型")
(setq DXFLST nil)
)
) ; END cond
(setq DXFLST (reverse DXFLST))
(if DXFLST
(progn
(setq DXFLST2 nil
LST1 nil ; 初始化
DXFLST3 nil
)
(foreach x DXFLST
(if (setq y (assoc (car x) DXFLST1))
(progn
(setq DXFLST3 (cons y DXFLST3)) ; 挑选出可以过滤的组码
(setq DXFLST2 (cons (cons (cadr x) (cdr y)) DXFLST2)) ; 转化成人
; 能轻易识别的DXF组码表
)
)
)
(MAKE-DCL-SSS DXFLST2) ; 创建并写对话框文件
(setq Dcl_Id (load_dialog dclname)) ; 载入对话框文件
(new_dialog "MY_SSS" Dcl_Id) ; 初始化对话框，在屏幕上显示
(action_tile "accept" "(done_dialog 1)")
(setq return (start_dialog)) ; 启动对话框
(if (and
(= return 1)
(> (length LST1) 0)
)
(progn
(setq lst4 nil)
(foreach N LST1
(setq LST4 (cons (nth N DXFLST3) LST4)) ; 取出要修改的组码代号
)
(setq SS (ssget lst4)) ; 过滤选择
(princ (strcat "\n 一共选择了 " (itoa (sslength ss))
" 个符合条件的对象。"
)
)
(sssetfirst nil ss)
) ; progn
) ; if
(unload_dialog Dcl_Id)
(vl-file-delete dclname)
) ; progn
) ; if
(princ)
)
好像是提示有问题，贴出来一下，方便大家学习
CAD 20221 中 提示write-line 函数不正确
点取源对象: 错误: 参数太多
是这情况
赞。来个动画吧，更形象。提个建议，最后不以(princ)结束，改SS,以便其它程序用这个结果。
赞赞赞赞赞赞赞赞赞
感谢 77077 分享学习!
下载学习了！
看一下......
源码好啊，感谢分享
赞一个，简单易行
这个跟天正2号键一样嘛
我嚓！居然要花钱了才能看？！第一次见到这么设置的！