各种线转多段线、面域

zdqwy19

创建边界.支持LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,MLINE,CIRCLE,ELLIPSE,HELIX；注意线重叠无效。各种线遵循原先线型，不作更改。


;;;显示边界线.
(defun zdqwy19xianshibianjiexian(/ e o s u p1 i l1 l2 ss _hit-test)
  (defun _hit-test ( pt lst )
    (vl-some
      (function
  (lambda ( obj / row col )
    (if(eq :vlax-true (vla-hittest obj (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col))
      (list obj row col))))
      lst))
  (prompt "显示边界线.")
  (setq o (getvar 'cmdecho) u (getvar 'nomutt) i (getvar 'osmode))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (setq ss (ssget "_X" (list (cons 0 "ACAD_TABLE") (cons 410 (getvar 'CTAB)))))
  (if(not ss)
    (progn
      (setq ss nil)
      (setvar 'osmode i)
      (setvar 'cmdecho o)
      (vl-exit-with-error (princ "不存在表格对象."))))
  (setq ss (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))));(setq ss (_ss->lst ss))
  (mapcar '(lambda(x)(vla-ClearSubSelection x)) ss)
  (setq p1 (getpoint "选择表格内文字:"))
  (setvar 'nomutt 1)
  (while p1;e
    (setq s (apply 'ssget (cons "C" ((lambda(x a b)(list (trans (list (- (car x)  a) (- (cadr x) b) 0.0) 2 1) (trans (list (+ (car x) a) (+ (cadr x) b) 0.0) 2 1)))
               (trans (getvar "viewctr") 1 2) (* (getvar "viewsize") (apply '/ (getvar "screensize")) 0.5) (* (getvar "viewsize") 0.5)))))
    (mapcar '(lambda(x)(redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (sssetfirst nil nil)
    (if(and(setq l1 (_hit-test p1 ss))
     (if(/= l1 nil)
       (progn
         (vla-setsubselection (car l1) (cadr l1) (cadr l1) (caddr l1) (caddr l1))
         (setq e (vla-GetText (car l1) (cadr l1) (caddr l1)))))
     (= (type (handent e)) 'ENAME)
     )
      (redraw (handent e) 3))
    (if(null l2)(setq l2 (car l1)))
    (cond
      ((and(= l1 nil)(/= l2 nil))(vla-ClearSubSelection l2))
      ((and(= l1 nil)(= l2 nil))(terpri))
      ((and(/= l1 nil)(/= (car l1) l2))(vla-ClearSubSelection l2))
      ((and(/= l1 nil)(= (car l1) l2))(terpri)))
    (setq l2 (car l1))
    (setq p1 (getpoint "选择表格内文字:"))
    )
  (setvar 'nomutt u)
  (mapcar '(lambda(x)(vla-ClearSubSelection x)) ss)
  (setq s (apply 'ssget (cons "C" ((lambda(x a b)(list (trans (list (- (car x)  a) (- (cadr x) b) 0.0) 2 1) (trans (list (+ (car x) a) (+ (cadr x) b) 0.0) 2 1)))
            (trans (getvar "viewctr") 1 2) (* (getvar "viewsize") (apply '/ (getvar "screensize")) 0.5) (* (getvar "viewsize") 0.5)))))
  (mapcar '(lambda(x)(redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
  (sssetfirst nil nil)
  (setvar 'osmode i)
  (setvar 'cmdecho o)
  (princ))