[编程交流] 如何从ea中删除一行

(defun c:weld2d ( / *error* unique dupnum LM:5P-Ellipse detm trp quad LM:defaultprops LM:point->param 3parc *adoc* ucsf ss i ent pepl ppel fuzz allptl n p1 p2 par k dpar pl enx mp ell arc ppl sfa )
 (vl-load-com)
 (defun *error* ( m )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (vla-endundomark *adoc*)
   (if m
     (prompt m)
   )
   (princ)
 )
 (defun unique ( l fuzz )
   (if l (cons (car l) (vl-remove-if '(lambda ( p ) (equal p (car l) fuzz)) (unique (cdr l) fuzz))))
 )
 (defun dupnum ( p l n )
   (- n (length (vl-remove p l)))
 )
 ;; 5-Point Ellipse  -  Lee Mac
 ;; Args: p1,p2,p3,p4,p5 - UCS points defining Ellipse
 ;; Returns a list of: ((10 <WCS Center>) (11 <WCS Major Axis Endpoint from Center>) (40 . <Minor/Major Ratio>))
 (defun LM:5P-Ellipse ( p1 p2 p3 p4 p5 / a av b c cf cx cy d e f i m1 m2 rl v x )
     (setq m1
         (trp
             (mapcar
                 (function
                     (lambda ( p )
                         (list
                             (* (car  p) (car  p))
                             (* (car  p) (cadr p))
                             (* (cadr p) (cadr p))
                             (car  p)
                             (cadr p)
                             1.0
                         )
                     )
                 )
                 (list p1 p2 p3 p4 p5)
             )
         )
     )
     (setq i -1.0)
     (repeat 6
         (setq cf (cons (* (setq i (- i)) (detm (trp (append (reverse m2) (cdr m1))))) cf)
               m2 (cons (car m1) m2)
               m1 (cdr m1)
         )
     )
     (mapcar 'set '(f e d c b a) cf) ;; Coefficients of Conic equation ax^2 + bxy + cy^2 + dx + ey + f = 0
     (if (< 0 (setq x (- (* 4.0 a c) (* b b))))
         (progn
             (if (equal 0.0 b 1e- ;; Ellipse parallel to coordinate axes
                 (setq av '((1.0 0.0) (0.0 1.0))) ;; Axis vectors
                 (setq av
                     (mapcar
                         (function
                             (lambda ( v / d )
                                 (setq v (list (/ b 2.0) (- v a)) ;; Eigenvectors
                                       d (distance '(0.0 0.0) v)
                                 )
                                 (mapcar '/ v (list d d))
                             )
                         )
                         (quad 1.0 (- (+ a c)) (- (* a c) (* 0.25 b b))) ;; Eigenvalues
                     )
                 )
             )
             (setq cx (/ (- (* b e) (* 2.0 c d)) x) ;; Ellipse Center
                   cy (/ (- (* b d) (* 2.0 a e)) x)
             )
             ;; For radii, solve intersection of axis vectors with Conic Equation:
             ;; ax^2 + bxy + cy^2 + dx + ey + f = 0  }
             ;; x = cx + vx(t)                       }- solve for t
             ;; y = cy + vy(t)                       }
             (setq rl
                 (mapcar
                     (function
                         (lambda ( v / vv vx vy )
                             (setq vv (mapcar '* v v)
                                   vx (car  v)
                                   vy (cadr v)
                             )
                             (apply 'max
                                 (quad
                                     (+ (* a (car vv)) (* b vx vy) (* c (cadr vv)))
                                     (+ (* 2.0 a cx vx) (* b (+ (* cx vy) (* cy vx))) (* c 2.0 cy vy) (* d vx) (* e vy))
                                     (+ (* a cx cx) (* b cx cy) (* c cy cy) (* d cx) (* e cy) f)
                                 )
                             )
                         )
                     )
                     av
                 )
             )
             (if (apply '> rl)
                 (setq rl (reverse rl)
                       av (reverse av)
                 )
             )
             (list
                 (cons 10 (trans (list cx cy) 1 0)) ;; WCS Ellipse Center
                 (cons 11 (trans (mapcar '(lambda ( v ) (* v (cadr rl))) (cadr av)) 1 0)) ;; WCS Major Axis Endpoint from Center
                 (cons 40 (apply '/ rl)) ;; minor/major ratio
             )
         )
     )
 )
 ;;;***********************************************************************************;;;
 ;;; (detm m) function calculates determinant of square martix                         ;;;
 ;;; Marko Ribar, d.i.a.                                                               ;;;
 ;;; Args: m - nxn matrix                                                              ;;;
 ;;; (detm '((0 1) (1 0)))                                                             ;;;
 ;;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
 ;;;***********************************************************************************;;;
 (defun detm ( m / d i j r )
   (defun d ( k n / z )
     (setq k (cdr k))
     (setq k (apply 'mapcar (cons 'list k)))
     (setq z -1)
     (while (<= (setq z (1+ z)) (length k))
       (if (eq z n)
         (setq k (cdr k))
         (setq k (reverse (cons (car k) (reverse (cdr k)))))
       )
     )
     (setq k (apply 'mapcar (cons 'list k)))
     (if (= (length k) 1) (caar k) k)
   )
   (if (not (eq (length m) 1))
     (progn
       (setq i -1)
       (setq j -1)
       (setq r 0)
       (foreach e (car m)
         (setq i (1+ i))
         (setq j (* j (- 1)))
         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
       )
       r
     )
     (caar m)
   )
 )
 ;; Matrix Transpose  -  Doug Wilson
 ;; Args: m - nxn matrix
 (defun trp ( m )
     (apply 'mapcar (cons 'list m))
 )
 ;; Quadratic Solution  -  Lee Mac
 ;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
 (defun quad ( a b c / d r )
     (if (<= 0 (setq d (- (* b b) (* 4.0 a c))))
         (progn
             (setq r (sqrt d))
             (list (/ (+ (- b) r) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
         )
     )
 )
 ;; Default Properties  -  Lee Mac
 ;; Returns a list of DXF properties for the supplied DXF data,
 ;; substituting default values for absent DXF groups
 (defun LM:defaultprops ( enx )
     (vl-remove nil
         (mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ((not (assoc (car x) enx)) nil) ( x )))
            '(
                 (006 . "BYLAYER")
                 (008 . "0")
                 (039 . 0.0)
                 (048 . 1.0)
                 (062 . 256)
                 (370 . -1)
                 (420 . 16777215)
             )
         )
     )
 )
 ;; Point -> Ellipse Parameter  -  Lee Mac
 ;; Returns the ellipse parameter for the given point
 ;; dxf  -  Ellipse DXF data (DXF groups 10, 11, 40, 210)
 ;; pnt  -  WCS Point on Ellipse
 ;; Uses relationship: ratio*tan(param) = tan(angle)
 (defun LM:point->param ( dxf pnt / ang ocs )
     (setq ocs (cdr (assoc 210 dxf))
           ang (- (angle (trans (cdr (assoc 10 dxf)) 0 ocs) (trans pnt 0 ocs))
                  (angle '(0.0 0.0) (trans (cdr (assoc 11 dxf)) 0 ocs))
               )
     )
     (atan (sin ang) (* (cdr (assoc 40 dxf)) (cos ang)))
 )
 (defun 3parc ( p1 p2 p3 / mid clockwise-p ang1 ang2 cen eang mid1 mid2 rad sang )
   (defun mid ( p1 p2 )
     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
   )
   (defun clockwise-p ( p1 p2 p3 ) ; Gile
     (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
   )
   (setq ang1 (angle p1 p2) ang2 (angle p2 p3)
         mid1 (mid p1 p2)   mid2 (mid p2 p3)
   
         cen  (inters mid1 (polar mid1 (+ ang1 (/ pi 2.)) 1.)
                      mid2 (polar mid2 (+ ang2 (/ pi 2.)) 1.) nil)
         
         rad  (distance cen p1)
   )
   (if (clockwise-p p1 p2 p3)
     (setq sAng (angle cen p3)
           eAng (angle cen p1)
     )
     (setq sAng (angle cen p1)
           eAng (angle cen p3)
     )
   )
   (list 
     (cons 10 cen)
     (cons 40 rad)
     (cons 50 sAng)
     (cons 51 eAng)
   )
 )
 (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (getvar 'worlducs) 0)
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (prompt "\nSelect 2d curves placed in WCS and on unlocked layer(s)...")
 (setq ss (ssget "_:L"))
 (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i))))
   (if (or (not (and (vlax-curve-isplanar ent) (equal (caddr (vlax-curve-getstartpoint ent)) 0.0 1e-6))) (and (wcmatch (cdr (assoc 0 (entget ent))) "SPLINE,ELLIPSE") (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-6)))
     (ssdel ent ss)
   )
 )
 (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i))))
   (cond
     ( (wcmatch (cdr (assoc 0 (entget ent))) "SPLINE,LINE,ARC,ELLIPSE,POLYLINE,LWPOLYLINE")
       (cond
         ( (and (= (cdr (assoc 0 (entget ent))) "POLYLINE") (not (or (= (cdr (assoc 70 (entget ent))) 0) (= (cdr (assoc 70 (entget ent))) 128) (= (cdr (assoc 70 (entget ent))) 1) (= (cdr (assoc 70 (entget ent))) 129))))
           (setq pepl (cons (list (vlax-curve-getstartpoint ent) ent (vlax-curve-getendpoint ent)) pepl))
         )
         ( (and (= (cdr (assoc 0 (entget ent))) "POLYLINE") (/= (cdr (assoc 90 (entget ent))) 2))
           (command "_.CONVERTPOLY" "_L" ent "")
           (setq ppel (cons (list (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget ent))) ent) ppel))
           (command "_.UNDO" "1")
         )
         ( (and (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (/= (cdr (assoc 90 (entget ent))) 2))
           (setq ppel (cons (list (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget ent))) ent) ppel))
         )
         ( t
           (setq pepl (cons (list (vlax-curve-getstartpoint ent) ent (vlax-curve-getendpoint ent)) pepl))
         )
       )
     )
   )
 )
 (setq fuzz 0.11)
 (while (> fuzz 0.1)
   (initget 6)
   (setq fuzz (getdist "\nPick or specify fuzz distance <1e-3> - should not be greater than 0.1 : "))
   (if (null fuzz)
     (setq fuzz 1e-3)
   )
 )
 (foreach pep pepl
   (setq allptl (cons (car pep) allptl) allptl (cons (last pep) allptl))
 )
 (foreach ppe ppel
   (setq allptl (append (mapcar '(lambda ( p ) (list (car p) (cadr p) 0.0)) (car ppe)) allptl))
 )
 (setq n (length allptl))
 (setq allptl (vl-sort allptl '(lambda ( a b ) (> (dupnum a allptl n) (dupnum b allptl n)))))
 (setq allptl (unique allptl (/ fuzz 2.5)))
 (foreach pep pepl
   (setq p1 (car pep) ent (cadr pep) p2 (caddr pep))
   (setq p1 (car (vl-member-if '(lambda ( p ) (equal p1 p fuzz)) allptl)))
   (setq p2 (car (vl-member-if '(lambda ( p ) (equal p2 p fuzz)) allptl)))
   (if (null p1)
     (setq p1 (car pep))
   )
   (if (null p2)
     (setq p2 (caddr pep))
   )
   (cond
     ( (= (cdr (assoc 0 (entget ent))) "ELLIPSE")
       (setq pl nil)
       (setq par (vlax-curve-getstartparam ent))
       (setq k -1 dpar (/ (- (vlax-curve-getendparam ent) par) 5.00000001))
       (repeat 5
         (setq pl (cons (vlax-curve-getpointatparam ent (+ par (* (setq k (1+ k)) dpar))) pl))
       )
       (setq pl (reverse pl))
       (if (equal p1 p2 1e-6)
         (setq p1 (car pep) p2 (caddr pep))
       )
       (setq pl (reverse (cons p2 (cdr (reverse (cons p1 (cdr pl)))))))
       (setq enx (entget ent))
       (entmake
         (append
          '(
             (0 . "ELLIPSE")
             (100 . "AcDbEntity")
             (100 . "AcDbEllipse")
           )
           (LM:defaultprops enx)
           (setq ell (LM:5P-Ellipse pl))
           (list
             (cons 41 (LM:point->param (cons (list 210 0.0 0.0 1.0) ell) p1))
             (cons 42 (LM:point->param (cons (list 210 0.0 0.0 1.0) ell) p2))
           )
           (list (list 210 0.0 0.0 1.0))
         )
       )
       (entdel ent)
     )
     ( (= (cdr (assoc 0 (entget ent))) "ARC")
       (setq mp (vlax-curve-getpointatparam ent (/ (+ (vlax-curve-getstartparam ent) (vlax-curve-getendparam ent)) 2.0)))
       (setq enx (entget ent))
       (if (equal p1 p2 1e-6)
         (setq p1 (car pep) p2 (caddr pep))
       )
       (entmake
         (append
          '(
             (0 . "ARC")
             (100 . "AcDbEntity")
             (100 . "AcDbCircle")
           )
           (LM:defaultprops enx)
           (list (car (setq arc (3parc p1 mp p2))) (cadr arc))
           (list (cons 100 "AcDbArc"))
           (list (caddr arc) (cadddr arc))
           (list (list 210 0.0 0.0 1.0))
         )
       )
       (entdel ent)
     )
     ( (= (cdr (assoc 0 (entget ent))) "LINE")
       (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget ent)) (entget ent))))))
       (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget ent)) (entget ent))))))
     )
     ( (= (cdr (assoc 0 (entget ent))) "POLYLINE")
       (if (= (cdr (assoc 100 (reverse (entget ent)))) "AcDb2dPolyline")
         (progn
           (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object ent))))))))
           (vlax-safearray-fill sfa (list (car p1) (cadr p1) (car p2) (cadr p2)))
           (vla-put-coordinates (vlax-ename->vla-object ent) (vlax-make-variant sfa))
         )
         (progn
           (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object ent))))))))
           (vlax-safearray-fill sfa (list (car p1) (cadr p1) 0.0 (car p2) (cadr p2) 0.0))
           (vla-put-coordinates (vlax-ename->vla-object ent) (vlax-make-variant sfa))
         )
       )
       (vla-update (vlax-ename->vla-object ent))
     )
     ( (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       (entupd (cdr (assoc -1 (entmod (subst (list 10 (car p1) (cadr p1)) (assoc 10 (entget ent)) (entget ent))))))
       (entupd (cdr (assoc -1 (entmod (subst (list 10 (car p2) (cadr p2)) (assoc 10 (reverse (entget ent))) (entget ent))))))
     )
     ( (= (cdr (assoc 0 (entget ent))) "SPLINE")
       (if (assoc 10 (entget ent))
         (progn
           (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget ent)) (entget ent))))))
           (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (reverse (entget ent))) (entget ent))))))
         )
         (progn
           (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget ent)) (entget ent))))))
           (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (reverse (entget ent))) (entget ent))))))
         )
       )
     )
   )
 )
 (foreach ppe ppel
   (setq pl (car ppe) ent (cadr ppe) ppl nil)
   (foreach p pl
     (setq ppl (cons (if (car (vl-member-if '(lambda ( x ) (equal (list (car p) (cadr p) 0.0) x fuzz)) allptl)) (car (vl-member-if '(lambda ( x ) (equal (list (car p) (cadr p) 0.0) x fuzz)) allptl)) p) ppl))
   )
   (setq ppl (reverse ppl))
   (cond
     ( (= (cdr (assoc 0 (entget ent))) "POLYLINE")
       (if (= (cdr (assoc 100 (reverse (entget ent)))) "AcDb2dPolyline")
         (progn
           (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object ent))))))))
           (vlax-safearray-fill sfa (vl-remove 0.0 (apply 'append ppl)))
           (vla-put-coordinates (vlax-ename->vla-object ent) (vlax-make-variant sfa))
         )
         (progn
           (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object ent))))))))
           (vlax-safearray-fill sfa (apply 'append ppl))
           (vla-put-coordinates (vlax-ename->vla-object ent) (vlax-make-variant sfa))
         )
       )
       (vla-update (vlax-ename->vla-object ent))
     )
     ( (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       (setq sfa (vlax-make-safearray vlax-vbdouble (cons 1 (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object ent))))))))
       (vlax-safearray-fill sfa (vl-remove 0.0 (apply 'append ppl)))
       (vla-put-coordinates (vlax-ename->vla-object ent) (vlax-make-variant sfa))
       (vla-update (vlax-ename->vla-object ent))
     )
   )
 )
 (*error* nil)
)