剪切后的多义线沿剪切边批量闭合怎么老出错

GTJ116600

我做了一个剪切后的多义线沿剪切边批量闭合，但是不知道为什么在家里调试没有问题，在单位调试老出错，麻烦各位版主，高人给诊诊脉
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;按计算三角形oij的倍面积（呵呵此次直接利用前辈成果）;;;;;;;;;;;;;;;;;;;;
(defun calo2A (pti ptj)
  (- (* (car pti) (cadr ptj)) (* (car ptj) (cadr pti)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;判断多段线是否为逆时针走向，ename图元必须为LWPOLYLINE;呵呵此次直接利用前辈成果
(defun clockwisep(ename / ptlist)
  (setq ptlist (apply 'append
               (mapcar '(lambda (x) (if (= 10 (car x)) (list(cdr x))))
               (entget ename))))
  (>  (apply '+ (mapcar 'calo2A (cons (last ptlist)(reverse (cdr (reverse ptlist)))) ptlist))
    0
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;获取实体内部一点坐标函数;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-ent-inpt(ent)
      (vl-load-com)
      (setq ifTNill (clockwisep ent))
      (if (= ifTNill T)
          (setq dist -1)
          (setq dist 1)
       )
      (setq obj (vlax-ename->vla-object ent))   
      (setq obj1 (vla-offset obj dist))     
      (setq ent1 (entlast))
      (setq entlist (entget ent1))
      (setq n 0 ent_list t m 1)
      (while ent_list
             (setq en (nth n entlist))
             (if (= (car en) 10)
                 (progn
                        (if (/= m 2)
                            (setq n (1+ n) m (1+ m))
                            (setq pt (cdr en) ent_list nil)
                        )
                 )
                 (setq n (+ 1 n) ent_list (nth n entlist))
             )
       )
      (entdel ent1)
      (command "change" ent "" "p" "c" 3  "")
      pt
;      (princ pt)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;获取PL实体点表函数;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-pl-ptlist(entname / entlist n ptlists ent_list en ptlist)
        (setq entlist (entget entname))
        (setq n 0 ptlists nil ent_list t)
        (while ent_list
             (setq en (nth n entlist))
             (setq ptlist (cdr en))
             (if (= (car en) 10)
                 (setq ptlists (cons ptlist ptlists))
             )
             (setq n (1+ n) ent_list (nth n entlist))
       )
       (setq ptlists (reverse ptlists))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;建立选择集函数 (待补充考虑多义线闭合问题);;;;;;;;;;;;;;;;;;;;;;         
(defun get-ptss( / trline)
       (setq trline (entsel "\n请选择剪切线"))
       (setq entname1 (car trline))
       (setq ptlists (get-pl-ptlist entname1))
       (princ ptlists)      
       (setq s1 (ssget "cp" ptlists '((0 . "*polyline")(70 . 0))))
       (princ s1)
;       (setq s1 (ssget "cp" ptlists '((0 . "*polyline"))))
;       (princ s1)
       (princ "\n选择集的长度")
       (princ (sslength s1))
;      (setq s2 (ssget "wp" ptlists '((0 . "*polyline"))))
;      (setq s3 (ssget "cp" ptlists '((0 . "*polyline")(70 . 1))))
       (setq num 0 ptlist nil m 0)      
       (while (> (sslength s1) num)
              (setq ent (ssname s1 num))
              (princ ent)
              (setq pt (get-ent-inpt ent) num (1+ num) ptlist (cons pt ptlist))
              (princ pt)
       )
       (princ ptlist)
       (princ "\n打印一点坐标")
       (princ (nth m ptlist))
       (setq m1 0 num1 0)
       (command  "-boundary")
       (while (> (length ptlist) m1)                     
              (command (nth m1 ptlist))
              (princ "\n打印循环内点坐标")
              (princ (nth m1 ptlist))
              (setq m1 (1+ m1))        
       )        
       (command "")
       (while (> (sslength s1) num1)
              (setq ent (ssname s1 num1))
              (entdel ent)
              (setq num1 (+ num1 1))
       )
       (setq s1 nil)         
)

sicky111

楼主测试的是哪个版本？

zyhandw

测试了下，没有问题！不知楼主测试时，有什么错误提示？

GTJ116600

zyhandw 发表于 2013-5-16 11:52
测试了下，没有问题！不知楼主测试时，有什么错误提示？

有的却实体莫名其妙的没有被选择上，有的被删掉了，闭合的多义线却没有生成

zyhandw

GTJ116600 发表于 2013-5-16 13:07
有的却实体莫名其妙的没有被选择上，有的被删掉了，闭合的多义线却没有生成

用你的“调试图形文件”是没有问题的！