组码比较

/db_自贡黄明儒_ · 发表于 2017-6-10 20:14:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;组码比较 自贡黄明儒 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

游客，如果您要查看本帖隐藏内容请回复

liuyj · 发表于 2017-6-10 20:57:26

序言里中间几句诗写的不错

dnbcgrass · 发表于 2017-6-10 21:05:02

回复学习学习！

正常V方式 · 发表于 2017-6-10 21:05:42

我来测试一下，行不行”

marting · 发表于 2017-6-10 22:06:26

支持黄大侠

marting · 发表于 2017-6-10 22:09:39

执行起来有错误呢？

yi13570 · 发表于 2017-6-10 22:11:37

回复学习学习！

yi13570 · 发表于 2017-6-10 22:20:11

支持支持，有个类似的组码浏览

/db_自贡黄明儒_ · 发表于 2017-6-10 22:22:52

marting 发表于 2017-6-10 22:09

我2016下执行通过，您水平那么高，发现问题了就帮完善一下吧！

yi13570 · 发表于 2017-6-10 22:36:00

yi13570 发表于 2017-6-10 22:20

确实是这样，并没有什么意义，虽然可以不停地浏览关联对象，但DCL对话框有不能超过8个的限制。

hao3ren · 发表于 2017-6-10 22:42:13

支持黄老师

819534890 · 发表于 2017-6-10 22:50:47

回复学习学习

Michael527 · 发表于 2017-6-10 23:34:05

这种工具还是很有用的，谢谢大师分享

sicky111 · 发表于 2017-6-11 00:05:46

牛。

kqqt6236 · 发表于 2017-6-11 00:08:49

回复学习学习。

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

[原创] 组码比较

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评