ssget时有时无选择问题，贴源代码。
本帖最后由 tm20038175 于 2011-5-28 16:07 编辑(defun c:et ()
(setq $orr *error*)
(setq *error* #err) ;当程序出错时就会执行#err函数
(setq pt2 null)
(setq ptlst null)
(setq oldmode (getvar "osmode") p1mode t)
(setvar "osmode" 0)
(setvar "CMDECHO" 0)
(if (setq pt2 (getpoint "\nSpecify a point:"))
(progn
(setq ptlst (list pt2))
(while (setq pt2 (getpoint pt2 "\nSpecify a point:"))
(redraw)
(setq ptlst (cons pt2 ptlst))
(grvecs (apply 'append (mapcar 'list ptlst (cdr ptlst))))
)
(princ "\n111111")
(setq ss (ssget "_WP"ptlst '((0 . "point"))))
(redraw)
;(sssetfirst nil ss)
)
)
(if (= ss nil) (exit) )
(princ "\n222222")
(Print_Piont1 ss)
(Print_Piont2 ss)
(sssetfirst nil ss)
(setvar "osmode" oldmode)
(setq *error* $orr)
(princ)
)
(defun Print_Piont1 (ss)
(setq num 0)
(setq l(sslength ss))
(setq l1(itoa l))
(princ (strcat "\n<Tm提取点程序>：\n一共提取了<" l1 "> 个点："))
(princ "\n<Tm提取点程序>：\n提取的点坐标为：")
(repeat l
; (princ "\n311111")
(setq ty(ssname ss num))
(setq data (entget ty))
;(princ data)
(setq z(cadddr(assoc 10 data)))
(setq x(car(cdr(assoc 10 data))))
(setq y(cadr(cdr(assoc 10 data))))
;(princ "\n[" )(princ x ) (princ " " ) (princ y ) (princ " " )
(princ z ) (princ "]" )
(setq xx(rtos x 2 3))
(setq yy(rtos y 2 3))
(setq zz(rtos z 2 3))
;)
;)
(princ "\n" )(princ xx ) (princ " " ) (princ yy ) (princ " " ) (princ zz
) (princ "" )
(setq num(+ num 1))
)
)
(defun Print_Piont2 (ss)
(setq num 0)
(setq l(sslength ss))
(setq l1(itoa l))
(princ (strcat "\n<Tm提取点程序>：\n一共提取了<" l1 "> 个点："))
(princ "\n<Tm提取点程序>：\n提取的点转换为MSC.Patran坐标为[<单位>(mm)]
：\n")
(princ "\n///%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%///\n")
(repeat l
; (princ "\n311111")
(setq ty(ssname ss num))
(setq data (entget ty))
;(princ data)
(setq z(cadddr(assoc 10 data))) (setq zm(/ z 1000))
(setq x(car(cdr(assoc 10 data))))(setq xm(/ x 1000))
(setq y(cadr(cdr(assoc 10 data)))) (setq ym(/ y 1000))
;(princ "\n[" )(princ x ) (princ " " ) (princ y ) (princ " " )
(princ z ) (princ "]" )
(setq xx(rtos xm 2 3))
(setq yy(rtos ym 2 3))
(setq zz(rtos zm 2 3))
;)
;)
(princ "[" )(princ xx ) (princ " " ) (princ yy ) (princ " " ) (princ zz
) (princ "]" )
(setq num(+ num 1))
)
(princ
"\n///*********************************************************************
***///\n")
)
(defun #err (s)
(princ "出错了")
(setvar "osmode" oldmode)
(setq *error* $orr)
)
哈哈，明白为什么错了，原来我选择多边形的时候多边形的边相交了，所以出错，选择时候应该小心点啊 没有的东西 (setq ss (ssget "_WP"ptlst '((0 . "point"))))
改成 (setq ss (ssget "_CP"ptlst '((0 . "point"))))
改成cp就变成框内选择了，其实只要选择多边形不要相交就可以了…………
页:
[1]