关于带关键字的SSGET。怎么加了高飞鸟的代码后，程序运行不了？
本帖最后由 scream2658 于 2014-7-29 14:51 编辑看了高飞鸟的带关键字的SSGET，觉得很强大。把它加到我的小程序里面，竟然加载后运行不了。求高手帮我看看这段代码的问题出在哪。我用了猫老师的编辑器后，运行时提示，8进制字符不正确。 例如： 提示 选择对象时可以接受 ALL选择全部一样吗？ ysq101 发表于 2014-7-28 15:57 static/image/common/back.gif
例如： 提示 选择对象时可以接受 ALL选择全部一样吗？
是的，就是带关键字的SSGET。在明经上看了飞诗的帖子，感觉好复杂啊。不知道有没有具体的源码学习下。 ;;;功能：标注引线长度修改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 原创：飞诗，来自明经通道论坛
;;转载、引用请注明出处
;;**********************************************
(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
;;;功能：标注引线长度修改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" '((0 . "DIMENSION")(-4 . "<OR")(70 . 32)(70 . 33)(70 . 160)(70 . 161)(-4 . "OR>"))))
(cond
((= SS "S") (setq new_dis (getdist"，请输入新的间距:")))
((= (type SS) 'PICKSET) (setq new_dis (getdist"，请输入新的间距:")))
(t nil)
);end_cond
(if (/= ss nil) (progn
(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原创：飞诗，来自明经通道论坛
;;转载、引用请注明出处
;;**********************************************
(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
大神啊。。。只有想不到。。没有做不到啊
页:
[1]