A程序后B程序就出错，选择集已被删除

ynhh

[Actionscript3] 纯文本查看 复制代码

(defun C:AA (/ ACADDOC PLOBJ PTB SSA obj)  (vl-load-com)
  (setq AcadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-StartUndoMark AcadDoc)
  (if (setq ssa (ssget '((0 . "Spline"))))
    (progn
      (vlax-for obj (vla-get-ActiveSelectionSet AcadDoc)
        (setq ptb (vlax-get-property obj "FitPoints"))
        (setq plobj (vla-AddPolyline (vla-get-ModelSpace AcadDoc) ptb))
        (vlax-put plobj "color" 1)
        (vla-delete obj)
      )
    )
  )
  (vla-EndUndoMark AcadDoc)
  (vlax-release-object AcadDoc)
  (princ)
)

;;;666666666666666666666666
(defun C:bb ()
  (spline-to-pline)
  (princ "\n已将样条曲线转为多段线")
  (princ)
) ;_ end o

(defun spline-to-pline (/ i)
  (vl-load-com)
  (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
        *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
                                        ;----------------------------------------------------------选取spline
  (setq spline-list (get-spline))
  (setq i (- 1))
  (if spline-list
    (progn                              ;(setq msg "\nNumber of segments <100>: ")
                                        ;(initget 6)
      (setq num 1000)
      (if (or (= num 100) (= num nil))
        (setq num 100)
      ) ;_ end of if
      (repeat (length spline-list)
        (setq splobj (nth (setq i (1+ i)) spline-list))
                                        ;---------------------------------------------Convert Spline的处理部分
        (convert-spline splobj num)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of spline-to-pline

(defun get-spline (/ spl-list obj spline no-ent i)
  (setq spl-list nil
        obj      nil
        spline   "AcDbSpline"
        selsets  (vla-get-selectionsets *thisdrawing*)
        ss1      (vlax-make-variant "ss1")
  ) ;_ end of setq
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq no-ent 1)
  (while no-ent                         ;--------------------------------------------------选择对象
    (vla-Selectonscreen ssobj)
    (if (> (vla-get-count ssobj) 0)
      (progn (setq no-ent nil)
             (setq i (- 1))
             (repeat (vla-get-count ssobj)
               (setq obj (vla-item ssobj (vlax-make-variant (setq i (1+ i)))) ;_ end of vla-item
               ) ;_ end of setq
               (cond ((= (vlax-get-property obj "ObjectName") spline)
                      (setq spl-list (append spl-list (list obj))) ;_ end of setq
                     )
               ) ;_ end-of cond
             ) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo entities selected, try again.")
    ) ;_ end of if
    (if (and (= nil no-ent) (= nil spl-list))
      (progn (setq no-ent 1)
             (prompt "\nNo splines selected.")
             (quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while  
  (vla-delete (vla-item selsets 0))
  spl-list
) ;_ end of get-spline

(defun convert-spline (splobj n / i)
  (setq point-list   nil
        2Dpoint-list nil
        z-list       nil
        spl-lyr      (vlax-get-property splobj 'Layer)
        startSpline  (vlax-curve-getStartParam splobj)
        endSpline    (vlax-curve-getEndParam splobj)
        i            (- 1)
  ) ;_ end of setq
                                        ;-------------------------------添加得到当前Spline的颜色码
                                        ;(setq c2 cons 62 col)
  (setq col (assoc 62 spobj))           ;-------------------------------颜色读取部分结束
  (repeat (+ n 1)
    (setq i (1+ i))
    (setq p (vlax-curve-getPointAtParam
              splobj
              (* i (/ (- endspline startspline) n)) ;_ end of *
            ) ;_ end of vlax-curve-getPointAtParam
    ) ;_ end of setq
    (setq 2Dp          (list (car p) (cadr p))
          2Dpoint-list (append 2Dpoint-list 2Dp)
          point-list   (append point-list p)
          z            (caddr p)
          z-list       (append z-list (list z))
    ) ;_ end of setq
  ) ;_ end of repeat
  (setq summ (apply '+ z-list))
  (setq arraySpace
         (vlax-make-safearray
           vlax-vbdouble                ; element type
           (cons 0 (- (length point-list) 1)) ; array dimension
         ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq vert-array (vlax-safearray-fill arraySpace point-list))
  (vlax-make-variant vert-array)
  (if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
           (= summ 0.0)
      ) ;_ end of and
                                        ;---------------------------------------------------------------添加polyline
    (setq plobj (add-polyline 2Dpoint-list vla-AddLightweightPolyline) ;_ end of add-polyline
    ) ;_ end of setq
    (setq plobj (add-polyline point-list vla-Add3DPoly) ;_ end of add-polyline
    ) ;_ end of setq
                                        ;-------------------------------------------------------------更新polyline色
  ) ;_ end of if
  (vlax-put-property plobj 'Layer spl-lyr)
  (vla-delete splobj)
  (vlax-release-object splobj)
) ;_ end of convert-spline

(defun add-polyline (pt-list poly-func)
  (setq arraySpace
         (vlax-make-safearray
           vlax-vbdouble
           (cons 0 (- (length pt-list) 1)) ; array dimension
         ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq vertex-array (vlax-safearray-fill arraySpace pt-list)) ;_ end of setq
  (vlax-make-variant vertex-array)
  (setq plobj (poly-func *modelspace* vertex-array) ;_ end of poly-func
  ) ;_ end of setq
) ;_ end of add-polyline

两个改样条曲线为多线的程序
先运行BB程序是正常的
但运行过AA程序后，BB程序出错如下：
; 错误: Automation 错误。 选择集已被删除
请教各位大师，不知如何修改AA程序才不影响BB程序？
谢谢

ynhh

运行过AA程序后，BB程序出错，也出现这情况：

错误: 参数类型错误: VLA-OBJECT nil

Lisphk

ynhh 发表于 2019-1-8 09:00
运行过AA程序后，BB程序出错，也出现这情况：

错误: 参数类型错误: VLA-OBJECT nil

楼主，去看看置顶的 论坛 贴代码的方法，把代码美化下，更方便看。

ynhh

Lisphk 发表于 2019-1-8 09:04
楼主，去看看置顶的 论坛 贴代码的方法，把代码美化下，更方便看。

谢谢您的指导