关于带关键字的SSGET。怎么加了高飞鸟的代码后，程序运行不了？

scream2658

   看了高飞鸟的带关键字的SSGET，觉得很强大。把它加到我的小程序里面，竟然加载后运行不了。求高手帮我看看这段代码的问题出在哪。我用了猫老师的编辑器后，运行时提示，8进制字符不正确。

ysq101

例如：   提示 选择对象时  可以接受 ALL  选择全部一样吗？

scream2658

ysq101 发表于 2014-7-28 15:57
例如：   提示 选择对象时  可以接受 ALL  选择全部一样吗？

是的，就是带关键字的SSGET。在明经上看了飞诗的帖子，感觉好复杂啊。不知道有没有具体的源码学习下。

scream2658

;;;功能：标注引线长度修改  Ver 1.1
;;;日期：2014.07.25
;;;作者：CADMAN

(defun c:qd(/ new_dis ss i dim_en pt10_old pt10_new pt10_XYZ pt14_old pt14_XYZ pt10_XYZ_new pt11_new pt11_XYZ_new dis key_word)
        (vl-load-com)
        (setq acadobj (vlax-get-acad-object))
        (setq dwgobj (vla-get-ActiveDocument acadobj))
        (if (= new_dis nil) (setq new_dis 800))
    (princ "\n当前引线修改长度为")(princ (rtos new_dis 2 1))
        (setq msg (strcat "选择对象[设置<S>]:"))
    (setq SS (Fsxm-ssget msg "S" '( (-4 . "<AND") (0 . "DIMENSION") (-4 . "<OR") (-4 . "<OR")(70 . 32) (70 . 33)(-4 . "OR>")(-4 . "<OR")(70 . 160)(70 . 161)(-4 . "OR>")(-4 . "OR>")(-4 . "AND>"))))
    (cond ((= SS "S") (setq new_dis (getdist  "，请输入新的间距:")))
                     ((= (type SS) 'PICKSET) (setq new_dis (getdist  "，请输入新的间距:")))
                         (t nil)
                   );end_cond
    (if (/= ss nil)
              (setq i 0)
              (repeat (sslength ss)
              (setq dim_en (entget (ssname ss i)))
              (setq xobj (vlax-ename->vla-object (ssname ss i)))
              (setq dis (vlax-get-property xobj 'ExtensionLineOffset))
              (setq pt10_old (assoc 10 dim_en))
              (setq pt10_XYZ (cdr pt10_old))
              (setq pt14_old (assoc 14 dim_en))
              (setq pt14_XYZ (cdr pt14_old))
              (setq pt10_XYZ_new (polar pt14_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))
              (setq pt10_new (append '(10) pt10_XYZ_new))
              (setq pt11_old (assoc 11 dim_en))
              (setq pt11_XYZ (cdr pt11_old))
              (setq pt11_XYZ_new (polar pt11_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))
              (setq pt11_new (append '(11) pt11_XYZ_new))
              (setq dim_en (subst pt10_new pt10_old dim_en) )
              (setq dim_en (subst pt11_new pt11_old dim_en) )
              (entmod dim_en)
              (setq i (1+ i))
                      );结束repeat!
     )    ;结束IF循环
(princ)
)

;;**********************************************
;;带关键字的 ssget&#160;&#160;原创：飞诗，来自明经通道论坛
;;转载、引用请注明出处
;;**********************************************
(defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc* Fsxm-entsel Fsxm-Split Fsxm-Pt2Str)
  (defun Fsxm-entsel (msg filter)
    (setq enp (entsel msg))
    (if (or (= (type enp) 'str)
            (and enp (ssget (cadr enp) filter))
        )
     enp
    )
  );
  (defun Fsxm-Split (string strkey / po strlst xlen)
    (setq xlen (1+ (strlen strkey)))
    (while (setq po (vl-string-search strkey string))
      (setq strlst (cons (substr string 1 po) strlst))
      (setq string (substr string (+ po xlen)))
    )
    (reverse (cons string strlst))
  )
  (defun Fsxm-Pt2Str (pt)
    (strcat (rtos (car pt) 2 2)
            ","
            (rtos (cadr pt) 2 2)
            ","
            (rtos (caddr pt) 2 2)
            "\n"
    )
  )
  (cond
        ((cadr (ssgetfirst)))
        (T
         (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
         (initget (strcat Kwd0 " " kwd))
         (cond ( (and (listp (setq var (Fsxm-entsel Msg Fil)))
                      (/= 52 (getvar "errno"))
                 );and
                 (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))
                 (ssget Fil)
               )
               ((member var (Fsxm-Split Kwd0 " "))
                (vla-sendcommand *doc* (strcat var "\n"))
                (ssget Fil)
               )
               (t var)
         )
        )
  );cond
);defun

ZZXXQQ

2. ;;;功能：标注引线长度修改  Ver 1.1
   
3. ;;;日期：2014.07.25
   
4. ;;;作者：CADMAN
   
5. (defun c:qd(/ new_dis ss i dim_en pt10_old pt10_new pt10_XYZ pt14_old pt14_XYZ pt10_XYZ_new pt11_new pt11_XYZ_new dis key_word)
   
6. (vl-load-com)
   
7. (setq acadobj (vlax-get-acad-object))
   
8. (setq dwgobj (vla-get-ActiveDocument acadobj))
   
9. (if (= new_dis nil) (setq new_dis 800))
   
10. (princ "\n当前引线修改长度为")(princ (rtos new_dis 2 1))
    
11. (setq msg (strcat "选择对象[设置<S>]:"))
    
12. (setq SS (Fsxm-ssget msg "S" '((0 . "DIMENSION")(-4 . "<OR")(70 . 32)(70 . 33)(70 . 160)(70 . 161)(-4 . "OR>"))))
    
13. (cond
    
14.   ((= SS "S") (setq new_dis (getdist  "，请输入新的间距:")))
    
15.   ((= (type SS) 'PICKSET) (setq new_dis (getdist  "，请输入新的间距:")))
    
16.   (t nil)
    
17. );end_cond
    
18. (if (/= ss nil) (progn
    
19.   (setq i 0)
    
20.   (repeat (sslength ss)
    
21.    (setq dim_en (entget (ssname ss i)))
    
22.    (setq xobj (vlax-ename->vla-object (ssname ss i)))
    
23.    (setq dis (vlax-get-property xobj 'ExtensionLineOffset))
    
24.    (setq pt10_old (assoc 10 dim_en))
    
25.    (setq pt10_XYZ (cdr pt10_old))
    
26.    (setq pt14_old (assoc 14 dim_en))
    
27.    (setq pt14_XYZ (cdr pt14_old))
    
28.    (setq pt10_XYZ_new (polar pt14_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))
    
29.    (setq pt10_new (append '(10) pt10_XYZ_new))
    
30.    (setq pt11_old (assoc 11 dim_en))
    
31.    (setq pt11_XYZ (cdr pt11_old))
    
32.    (setq pt11_XYZ_new (polar pt11_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))
    
33.    (setq pt11_new (append '(11) pt11_XYZ_new))
    
34.    (setq dim_en (subst pt10_new pt10_old dim_en) )
    
35.    (setq dim_en (subst pt11_new pt11_old dim_en) )
    
36.    (entmod dim_en)
    
37.    (setq i (1+ i))
    
38.   );结束repeat!
    
39. ))    ;结束IF循环
    
40. (princ)
    
41. )
    
42. ;;**********************************************
    
43. ;;带关键字的 ssget  原创：飞诗，来自明经通道论坛
    
44. ;;转载、引用请注明出处
    
45. ;;**********************************************
    
46. (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc* Fsxm-entsel Fsxm-Split Fsxm-Pt2Str)
    
47. (defun Fsxm-entsel (msg filter)
    
48.   (setq enp (entsel msg))
    
49.   (if (or (= (type enp) 'str)
    
50.             (and enp (ssget (cadr enp) filter))
    
51.       )
    
52.    enp
    
53.   )
    
54. )
    
55. (defun Fsxm-Split (string strkey / po strlst xlen)
    
56.   (setq xlen (1+ (strlen strkey)))
    
57.   (while (setq po (vl-string-search strkey string))
    
58.    (setq strlst (cons (substr string 1 po) strlst))
    
59.    (setq string (substr string (+ po xlen)))
    
60.   )
    
61.   (reverse (cons string strlst))
    
62. )
    
63. (defun Fsxm-Pt2Str (pt)
    
64.   (strcat (rtos (car pt) 2 2) ","
    
65.             (rtos (cadr pt) 2 2) ","
    
66.             (rtos (caddr pt) 2 2) "\n"
    
67.   )
    
68. )
    
69. (cond
    
70.   ((cadr (ssgetfirst)))
    
71.   (T
    
72.    (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
    
73.    (initget (strcat Kwd0 " " kwd))
    
74.    (cond ( (and (listp (setq var (Fsxm-entsel Msg Fil)))
    
75.                       (/= 52 (getvar "errno"))
    
76.                );and
    
77.     (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))
    
78.     (ssget Fil)
    
79.    )
    
80.    ((member var (Fsxm-Split Kwd0 " "))
    
81.     (vla-sendcommand *doc* (strcat var "\n"))
    
82.     (ssget Fil)
    
83.    )
    
84.    (t var)
    
85.   )
    
86. )
    
87. );cond
    
88. );defun
    

;;;功能：标注引线长度修改  Ver 1.1<br /> ;;;日期：2014.07.25<br /> ;;;作者：CADMAN<br /> (defun c:qd(/ new_dis ss i dim_en pt10_old pt10_new pt10_XYZ pt14_old pt14_XYZ pt10_XYZ_new pt11_new pt11_XYZ_new dis key_word)<br /> (vl-load-com)<br /> (setq acadobj (vlax-get-acad-object))<br /> (setq dwgobj (vla-get-ActiveDocument acadobj))<br /> (if (= new_dis nil) (setq new_dis 800))<br /> (princ "\n当前引线修改长度为")(princ (rtos new_dis 2 1))<br /> (setq msg (strcat "选择对象[设置<S>]:"))<br /> (setq SS (Fsxm-ssget msg "S" '((0 . "DIMENSION")(-4 . "<OR")(70 . 32)(70 . 33)(70 . 160)(70 . 161)(-4 . "OR>"))))<br /> (cond<br />   ((= SS "S") (setq new_dis (getdist  "，请输入新的间距:")))<br />   ((= (type SS) 'PICKSET) (setq new_dis (getdist  "，请输入新的间距:")))<br />   (t nil)<br /> );end_cond<br /> (if (/= ss nil) (progn<br />   (setq i 0)<br />   (repeat (sslength ss)<br />    (setq dim_en (entget (ssname ss i)))<br />    (setq xobj (vlax-ename->vla-object (ssname ss i)))<br />    (setq dis (vlax-get-property xobj 'ExtensionLineOffset))<br />    (setq pt10_old (assoc 10 dim_en))<br />    (setq pt10_XYZ (cdr pt10_old))<br />    (setq pt14_old (assoc 14 dim_en))<br />    (setq pt14_XYZ (cdr pt14_old))<br />    (setq pt10_XYZ_new (polar pt14_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))<br />    (setq pt10_new (append '(10) pt10_XYZ_new))<br />    (setq pt11_old (assoc 11 dim_en))<br />    (setq pt11_XYZ (cdr pt11_old))<br />    (setq pt11_XYZ_new (polar pt11_XYZ (angle pt14_XYZ pt10_XYZ) (+ new_dis dis)))<br />    (setq pt11_new (append '(11) pt11_XYZ_new))<br />    (setq dim_en (subst pt10_new pt10_old dim_en) )<br />    (setq dim_en (subst pt11_new pt11_old dim_en) )<br />    (entmod dim_en)<br />    (setq i (1+ i))<br />   );结束repeat!<br /> ))    ;结束IF循环<br /> (princ)<br /> )<br /> ;;**********************************************<br /> ;;带关键字的 ssget  原创：飞诗，来自明经通道论坛<br /> ;;转载、引用请注明出处<br /> ;;**********************************************<br /> (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc* Fsxm-entsel Fsxm-Split Fsxm-Pt2Str)<br /> (defun Fsxm-entsel (msg filter)<br />   (setq enp (entsel msg))<br />   (if (or (= (type enp) 'str)<br />             (and enp (ssget (cadr enp) filter))<br />       )<br />    enp<br />   )<br /> )<br /> (defun Fsxm-Split (string strkey / po strlst xlen)<br />   (setq xlen (1+ (strlen strkey)))<br />   (while (setq po (vl-string-search strkey string))<br />    (setq strlst (cons (substr string 1 po) strlst))<br />    (setq string (substr string (+ po xlen)))<br />   )<br />   (reverse (cons string strlst))<br /> )<br /> (defun Fsxm-Pt2Str (pt)<br />   (strcat (rtos (car pt) 2 2) ","<br />             (rtos (cadr pt) 2 2) ","<br />             (rtos (caddr pt) 2 2) "\n"<br />   )<br /> )<br /> (cond<br />   ((cadr (ssgetfirst)))<br />   (T<br />    (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")<br />    (initget (strcat Kwd0 " " kwd))<br />    (cond ( (and (listp (setq var (Fsxm-entsel Msg Fil)))<br />                       (/= 52 (getvar "errno"))<br />                );and<br />     (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))<br />     (ssget Fil)<br />    )<br />    ((member var (Fsxm-Split Kwd0 " "))<br />     (vla-sendcommand *doc* (strcat var "\n"))<br />     (ssget Fil)<br />    )<br />    (t var)<br />   )<br /> )<br /> );cond<br /> );defun<br />

ysq101

大神啊。。。只有想不到。。没有做不到啊