组码比较
本帖最后由 /db_自贡黄明儒_ 于 2017-6-14 14:14 编辑原来我本论坛写了一个“组码比较”，自己使用起来也不满意。于是我反复思哟想哟，感到
才情不够；反复写哟改哟，时常捉襟见肘。我食不甘味、辗转反侧、废寝忘食、挑灯夜战、壮志凌云、壮心不已，
终于上苍怜我，才有了下面的模样。这个界面自我觉得友好，对于初如编程也许有用。对我
自己而言，也记不住组码的意义，用此程序来查查。特别对于单行文字，先击它，改变定位
点再击它，可以看到组码的变化。
对于组码的解释，我也觉得不太完善，希望有高手改进一下。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;组码比较 自贡黄明儒 2017.6.10
;;列表框增加内容
;;(DCL-ADDLIST "ltypelist1" Ltypes "0"),用在new_dialog之后
;;(defun dcl-AddListAddList (key val item);列表框加载
(defun C:SameEnt (/ DCLID E EN FLAG FN FNAME LST LST1 LST2 RETURN# STR VAL)
(defun dialog ()
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line
"//dcl_settings :default_dcl_settings{audit_level = 0;}"
fn
)
(write-line "SameEnt : dialog{label=\"组码比较\";" fn)
(write-line ":row{" fn)
(write-line " :column{label=\"先\";" fn)
(write-line
" :button{label=\"<<Pick&1\";key=\"Pick1\";} "
fn
)
(write-line
" :list_box{key=\"l1\";width=27;height=24;multiple_select=true;}"
fn
)
(write-line " }" fn)
(write-line " :column{label=\"后\";" fn)
(write-line
" :button{label=\"<<Pick&2\";key=\"Pick2\";} "
fn
)
(write-line
" :list_box{key=\"l2\";width=27;height=24;multiple_select=true;}"
fn
)
(write-line " }" fn)
(write-line " :column{" fn)
(write-line
" :list_box{label=\"(先 后)差异表\";key=\"l3\";width=27;height=18;}"
fn
)
(write-line
" :text{key=\"l4\";width=27;height=6;value=\"比较同一对象，要运行二次
\";}"
fn
)
(write-line " }" fn)
(write-line "}" fn)
(write-line " ok_only;" fn)
(write-line "}" fn)
(close fn)
)
(defun doPick1 ()
(if (setq e (car (nentsel "\n 点取图元")))
(progn
(setq en (entget e))
(setq *compareEn1* (mapcar 'VL-PRIN1-TO-STRING en))
)
)
)
(defun doPick2 ()
(if (setq e (car (nentsel "\n 点取图元")))
(progn
(setq en (entget e))
(setq *compareEn2* (mapcar 'VL-PRIN1-TO-STRING en))
)
)
)
(defun setdata ()
(dcl-AddListAddList "l1" *compareEn1* nil)
(dcl-AddListAddList "l2" *compareEn2* nil)
(SameEnt)
(dcl-AddListAddList "l3" Lst "0")
(if val (set_tile "l4" val))
)
(defun SameEnt ()
(setq Lst1 nil)
(setq Lst2 nil)
(if (and *compareEn1* *compareEn2*)
(progn
(foreach x *compareEn1*
(if (not (member x *compareEn2*))
(setq Lst1 (cons x Lst1))
)
)
(setq Lst1 (cons "先" (reverse Lst1)))
(foreach x *compareEn2*
(if (not (member x *compareEn1*))
(setq Lst2 (cons x Lst2))
)
)
(setq Lst2 (cons "后" (reverse Lst2)))
(setq Lst (append Lst1 Lst2))
)
)
)
(defun dol3 ()
(SameEnt)
(setq FLAG nil)
(setq str nil)
;;下句-1组码时，用read出错
(setq FLAG (nth (read val) Lst))
(if (or (= FLAG "先") (= FLAG "后"))
(setq str "比较同一对象，要运行二次")
(if (vl-catch-all-error-p
(setq FLAG (vl-catch-all-apply 'read (list FLAG)))
)
(setq str "图元软指针")
(progn
(setq Flag (car FLAG))
(setq str
(cond
((= FLAG -1) "图元名")
((= FLAG 0) "图元类型")
((= FLAG 1) "默认值\n输入的标注文字")
((= FLAG 2) "名称")
((= FLAG 3)
"附加文字(始终在长度为\n 250 个字符的数据块中)\n标注样式名"
)
((= FLAG 5) "图元句柄")
((= FLAG 6) "线型名")
((= FLAG 7) "文字样式名")
((= FLAG 8) "图层名")
((= FLAG 10) "第一对齐点(OCS中)\n起点\n插入点\中心点")
((= FLAG 11)
"第二对齐点(OCS中)\n只有当72或73组的值\n非零时，该值才有意义
\n标注文字的中点"
)
((= FLAG 12) "标注克隆的插入点\n基线和连续(OCS中)")
((= FLAG 13)
"线性标注和角度标注的定义点\n指定的第一个延长线的起点"
)
((= FLAG 14)
"线性标注和角度标注的定义点\n指定的第二个延长线的起点"
)
((= FLAG 15) "直径标注、半径标注和角度标注的定义点")
((= FLAG 16) "定义角度标注的标注圆弧的点")
((= FLAG 39) "厚度(选项; 缺省 = 0)")
((= FLAG 40) "文字高度\n半径标注和直径标注的引线长度\n半径")
((= FLAG 41) "宽度因子")
((= FLAG 42) "水平宽度\n等于或小于组码41的值")
((= FLAG 43) "多行文字垂直高度")
((= FLAG 48) "线型比例(选项)")
((= FLAG 50) "弧度")
((= FLAG 51) "倾斜角")
((= FLAG 52) "旋转角度(组码 50)时，\n将给出尺寸界线的角度")
((= FLAG 53) "标注文字与其默认方\n向所成的旋转角度")
((= FLAG 60) "0可性\n1不可见")
((= FLAG 62)
"颜色号 0 = 随块.256 = 随层\n负值表示层关闭. 禁止(选项)"
)
((= FLAG 67) "0模型空间/1图纸空间")
((= FLAG 70) "标注类型")
((= FLAG 71)
"1\n左上2\n中上3\n右上4\n左中5\n正中6\n右中7\n左下8\n中下9\n
右下\n2文字反向(在X轴方向镜像)\n4文字倒置(在Y轴方向镜像)"
)
((= FLAG 72)
"0\n左对正1\n居中对正2\n右对正3\n对齐(如果垂直对齐 = 0)4\n中
间(如果垂直对齐 = 0)5\n拟合(如果垂直对齐 = 0)"
)
((= FLAG 73)
"垂直0\n基线对正1\n底端对正2\n居中对正3\n顶端对正"
)
((= FLAG 100) "子类数据标记")
((= FLAG 102) "供应用程序使用的控制字符串")
((= FLAG 210) "拉伸方向\n(选项; 缺省 = 0, 0, 1)\n 3D矢量")
(T "比较同一对象，要运行二次")
)
)
)
)
)
(set_tile "l4" str)
)
(dialog)
(setq dclid (load_dialog fname))
(setq return# 3)
(while (> return# 1)
;;根据需要自处理开始,DCLName必须填写
(new_dialog "SameEnt" dclid)
(setdata)
(action_tile "accept" "(done_dialog 1)")
(action_tile "Pick1" "(done_dialog 2)")
(action_tile "Pick2" "(done_dialog 3)")
(action_tile "l3" "(setq val $value)(dol3)")
(setq return# (start_dialog))
(cond
((= return# 1))
((= return# 2) (doPick1))
((= return# 3) (doPick2))
)
)
(unload_dialog dclid)
(vl-file-delete fname)
(princ "\n")
(princ Lst)
(princ)
)
(princ "\n 组码比较命令SameEnt")
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;组码比较 自贡黄明儒 2017.6.10**** Hidden Message *****
序言里中间几句诗写的不错 回复学习学习！ 我来测试一下，行不行”
支持黄大侠
执行起来有错误呢？
回复学习学习！
支持支持，有个类似的组码浏览
marting 发表于 2017-6-10 22:09
我2016下执行通过，您水平那么高，发现问题了就帮完善一下吧！
yi13570 发表于 2017-6-10 22:20
确实是这样，并没有什么意义，虽然可以不停地浏览关联对象，但DCL对话框有不能超过8个的限制。
支持黄老师 回复学习学习
这种工具还是很有用的，谢谢大师分享 牛。 回复学习学习。