哪位大神有兴趣有时间给优化下这个插件啊

suncad

插件的功能是给一个闭合的图形中，选中的那个边单独偏移一个指定的宽度。现在大部分的图形能正常使用，有的文件偶尔就会出错，搞不懂什么原因。



(DEFUN A->OBJLST (A / count i len obj objlst ss style x)
(if A
(PROGN
(setq STYLE (type A) SS (SSADD))
;以下根据A的类型分类
(cond
;1 单个图元名对象
((= style 'ENAME)
(vl-catch-all-apply '(lambda () (SetQ OBJLST (LIST  (vlax-ename->vla-object A)))))
)
;2、SSGET选择集
((= STYLE 'PICKSET)
(setq len (sslength A) i 0)
(repeat len
(setq obj nil)
(vl-catch-all-apply '(lambda () (setq obj (vlax-ename->vla-object (ssname A i)))))
(if obj (setq OBJLST (append OBJLST (list obj))))
(setq i (1+ i))
)
)

;3 图元名表，还可增加OBJ表类
((= STYLE 'LIST)
(if (= (TYPE (car A)) 'VLA-OBJECT)
(setq OBJLST A)
(SETQ OBJLST (mapcar 'vlax-ename->vla-object A))
)
)
)
OBJLST
)
nil
)
)

;任意对象转ssget 选择集
(DEFUN A->SS (A / count en obj ss style x)
(if A
(PROGN
(setq STYLE (type A) SS (SSADD))
;以下根据A的类型分类
(cond
;1 单个图元名对象
((= style 'ENAME)
(if (entget a) (SSADD a ss))
)
;2、SSGET选择集
((= STYLE 'PICKSET)
(setq ss A)
)
;3 图元名或OBJ表
((= STYLE 'LIST)
(if (= (TYPE (car A)) 'ENAME)
(FOREACH en A (if (entget en) (SSADD EN SS)))
(FOREACH OBJ A (if (setq en (vlax-vla-object->ename OBJ)) (SSADD en SS) ))
)
)
;4 VLA选择集
((and (= STYLE 'VLA-OBJECT) (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (SETQ COUNT (Vlax-Get A 'Count)))))))
(vlax-map-collection A '(lambda (x) (if (setq en (vlax-vla-object->ename x)) (SSADD en SS))))
)
;5 单个OBJ对象
((= style 'VLA-OBJECT)
(if (setq en (vlax-vla-object->ename A))
(SSADD en SS)
)
)

)
SS
)
nil
)
)
;任意对象转图元名表
(DEFUN A->ENLST (A / count enlst i len s1 style x)
(if A
(PROGN
(setq STYLE (type A))
;以下根据A的类型分类
(cond
;1 单个图元名对象
((= style 'ENAME)
(setq ENlst (LIST A))
)
;2、SSGET选择集
((= STYLE 'PICKSET)
(setq len (sslength A) i 0)
(repeat len
(setq s1 (ssname A i))
(setq enlst (append enlst (list s1)))
(setq i (1+ i))
)
)

;3 图元名表，还可增加OBJ表类
((= STYLE 'LIST)
(if (= (TYPE (car A)) 'ENAME)
(setq enlst A)
(SETQ ENLST (mapcar 'vlax-vla-object->ename A))
)
)

;4 VLA选择集
((and (= STYLE 'VLA-OBJECT) (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (SETQ COUNT (Vlax-Get A 'Count)))))))
(vlax-map-collection A '(lambda (x) (SETQ enLST (APPEND enLST (LIST (vlax-vla-object->ename X))))))
)

;5 OBJ对象数组
((= style 'safearray)
(SETQ ENLST (mapcar 'vlax-vla-object->ename (vlax-safearray->list A)))
)
;6 单个OBJ对象
((= style 'VLA-OBJECT)
(setq enlst (LIST (vlax-vla-object->ename A)))
)
)
enlst
)
nil
)
)
(defun ENTNEXT_LST (EN / enlst s1)
(WHILE (SETQ S1 (ENTNEXT EN))
(SETQ ENLST (APPEND ENLST (LIST S1)))
(SETQ EN S1)
)
ENLST
)

;分解,返回分解后的图元名表
;sslst 图元名表
(DEFUN Explode (A / en enlst qa_bak s s0 ss ss2 sslst)
(setq s (entlast) ss2 (ssadd))
(setq QA_bak  (getvar "QAFLAGS"))
(setvar "QAFLAGS" 1);不对此参数进行设置将无法实现一次性炸开SS1的目的
(setq ss (A->ss A))
(command "explode" ss "")
(setvar "QAFLAGS" QA_bak)
(if (setq enlst (vl-remove-if 'not (a->enlst a)))
(setq enlst (vl-remove-if-not 'entget (a->enlst A)))
)
(append (entnext_lst s) enlst)
)

(defun c:tt( / enlst_all d e1 e2 en en1 en2 enlst enlst_last enlst_of enlst_of1 enlst_of2 enlst2 obj obj2 obj2_1 obj2_2 obj2_max obj2_min p_e p_s p_s_0 p_s_0_e p_s_0_s p_s_1 p_s_1_e p_s_1_s p0 ps3_e ps3_s s s_0 s_1 s_3 s0 s1 ss x)


(setq os_bak (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)

(princ "\n+++++++++++++++++++++1、正值-外扩  2、负值-内缩+++++++++++++++++++++++++++++")
(if c5276_d
(setq d (getstring (strcat "\n请输入偏移距离(" c5276_d "):")))
(setq d (getstring (strcat "\n请输入偏移距离:" )))
)
(if (or (not d) (= d "") )
(setq d c5276_d)
)

(setq c5276_d d)
(setq d (read d))
(while (setq s(entsel))
(command "undo" "be")
(setq en (car s))

(setq obj (vlax-ename->vla-object en))
(setq P0 (vlax-curve-getClosestPointTo en (CADR S)))
(vla-copy (vlax-ename->vla-object en))
(setq enlst (explode (entlast)))
(setq s1 (ssname (ssget "c" p0 p0) 0)) ;所点击的那条线
(setq enlst (vl-remove s1 enlst));
(setq p_s (vlax-curve-getPointAtDist s1 0)) ;所点击的起点
(setq p_e (vlax-curve-getPointAtDist s1 (vlax-curve-getDistAtParam s1 (vlax-curve-getEndParam s1))));所点击的终点
(setq ss (ssget "c" p_s p_s) )
(setq s_0 (ssname (ssdel s1 ss) 0)) ;上一条边线
(setq ss (ssget "c" p_e p_e) )
(setq s_1 (ssname (ssdel s1 ss) 0)) ;下一条边线

(setq s0 (entlast))
(vla-offset obj d)
(setq enlst_of (ENTNEXT_LST s0))
(setq enlst_of (vl-remove-if-not '(lambda(x) (= (cdr (assoc 0 (entget x))) "LWPOLYLINE"))ENLST_OF))
(if (> (length enlst_of) 1)
(setq en1 (CAR (vl-SORT enlst_of  '(lambda(E1 E2) (> (vla-get-area (vlax-ename->vla-object E1)) (vla-get-area (vlax-ename->vla-object E2)))))))
(setq en1 (car enlst_of))
)
(SETQ ENLST_OF1 (VL-REMOVE en1 ENLST_OF))
(mapcar 'entdel ENLST_OF1)
(setq obj2_1 (vlax-ename->vla-object en1))

(setq s0 (entlast))
(vla-offset obj (* -1. d))
(setq enlst_of (ENTNEXT_LST s0))
(setq enlst_of (vl-remove-if-not '(lambda(x) (= (cdr (assoc 0 (entget x))) "LWPOLYLINE")) ENLST_OF))
(if (> (length enlst_of) 1)
(setq en2 (CAR (vl-SORT enlst_of  '(lambda(E1 E2) (> (vla-get-area (vlax-ename->vla-object E1)) (vla-get-area (vlax-ename->vla-object E2)))))))
(setq en2 (car enlst_of))
)
(SETQ ENLST_OF2 (VL-REMOVE en2 ENLST_OF))
(mapcar 'entdel ENLST_OF2)
(setq obj2_2 (vlax-ename->vla-object en2))
(if (< (vla-get-area obj2_1) (vla-get-area obj2_2))
(setq obj2_max obj2_2 obj2_min obj2_1)
(setq obj2_max obj2_1 obj2_min obj2_2)
)

;(command "zoom" "o" en en1 en2 "")

(if (> d 0)
(progn
(setq obj2 obj2_max)
(vla-delete obj2_min)
)
(progn
(setq obj2 obj2_min)
(vla-delete obj2_max)
)
)

(setq enlst2 (explode obj2))

(setq s_3 (car (vl-remove-if-not '(lambda(x) (equal  (distance (vlax-curve-getClosestPointTo x p0) P0) (abs d) 0.001)) enlst2)))

(setq ps3_s (vlax-curve-getPointAtDist s_3 0)) ;所点击的起点

(setq ps3_e (vlax-curve-getPointAtDist s_3 (vlax-curve-getDistAtParam s_3 (vlax-curve-getEndParam s_3))));所点击的终点
(setq enlst2 (vl-remove s_3 enlst2))

(mapcar 'entdel enlst2)

(setq p_s_0_s (vlax-curve-getPointAtDist s_0 0.01)) ;上一条边线的起点
(setq p_s_0_e (vlax-curve-getPointAtDist s_0 (-(vlax-curve-getDistAtParam s_0 (vlax-curve-getEndParam s_0)) 0.01))) ;终点
(if (< (distance (vlax-curve-getClosestPointTo s_3 p_s_0_s) p_s_0_s) (distance (vlax-curve-getClosestPointTo s_3 p_s_0_e) p_s_0_e))
(setq p_s_0  p_s_0_s)
(setq p_s_0  p_s_0_e)
)



(setq p_s_1_s (vlax-curve-getPointAtDist s_1 0.01)) ;上一条边线的起点
(setq p_s_1_e (vlax-curve-getPointAtDist s_1 (-(vlax-curve-getDistAtParam s_1 (vlax-curve-getEndParam s_1)) 0.01))) ;下一条边线的终点
(if (< (distance (vlax-curve-getClosestPointTo s_3 p_s_1_s) p_s_1_s) (distance (vlax-curve-getClosestPointTo s_3 p_s_1_e) p_s_1_e))
(setq p_s_1  p_s_1_s)
(setq p_s_1  p_s_1_e)
)

(setq s0 (entlast))

(command "EXTEND" s_0 s_1  "" "e" "e" (list s_3 ps3_s) (list s_3 ps3_e) "")
(setq ps3_s (vlax-curve-getPointAtDist s_3 0)) ;所点击的起点
(setq ps3_e (vlax-curve-getPointAtDist s_3 (vlax-curve-getDistAtParam s_3 (vlax-curve-getEndParam s_3))));所点击的终点

(command "EXTEND" s_3  "" (list s_0 p_s_0) (list s_1 p_s_1) "")

(command "TRIM" s_0 s_1 "" (list s_3 ps3_s) (list s_3 ps3_e) "")

(command "TRIM" s_3 "" (list s_0 p_s_0) (list s_1 p_s_1) "")

(setq enlst_last (ENTNEXT_LST s0))
(setq enlst (append enlst enlst_last))
(setq enlst (vl-remove-if-not 'entget enlst))

; (COMMAND "_.fillet" "r" 0 )
; (COMMAND "_.fillet"  (list s_3 ps3_e) (list s_0 p_s_0_s))
; (COMMAND "_.fillet"  (list s_3 ps3_s) (list s_1 p_s_1_e))
(command "pedit" s_3 "y" "j" (a->ss enlst) "" "")
(entdel s1)
(Vlax-Put-Property (Vlax-Ename->Vla-Object en) 'Color 252)
(setq enlst_all (append enlst_all (list en)))
(Vlax-Put-Property (Vlax-Ename->Vla-Object (setq enz (entlast))) 'Color 2 )
(command "DRAWORDER" enz "" "f")
(command "REGEN")
;(command "zoom" "o" "P")
(command "undo" "e")
)
(setq st t)
(while (and st (/= (setq txt (strcase (getstring "\n是否删除原始对象（Y-删除）？"))) ""))
(if (= txt "Y")
(PROGN
(mapcar 'entdel enlst_all)
(setq st nil)
)
(progn
(princ "\n关键词输入有误，请重输！")
)
)


)
(setvar "osmode" os_bak)
(princ)
)

东升铮

有的文件偶尔会出错，这话说的太笼统了，最好上出错的文件看看。并且说一下你的测试过程出现了什么。你一言我一语就能把问题处理完。