[编程交流] 仅选择属性块

(defun c:SWCC (/ _pac add ss i e temp it o a b pts tempC i3 ec)
 ;; Select Within/Crossing Curve
 (vl-load-com)
 (defun _pac (e / l v d lst)
   (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
   (while (< (setq d (+ d v)) l)
     (setq lst (cons (trans (vlax-curve-getPointAtDist e d) 0 1) lst))
   )
 )
 (initget 0 "Crossing Within")
 (setq *SWCC:Opt*
        (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                 (cond (*SWCC:Opt*)
                                       ((setq *SWCC:Opt* "Crossing"))
                                 )
                                 ">: "
                         )
               )
              )
              (*SWCC:Opt*)
        )
 )
 (princ "\nSelect closed curves to select object(s) within: ")
 (if (setq add (ssadd)
           ss  (ssget '((-4 . "<OR")
                        (0 . "CIRCLE,ELLIPSE")
                        (-4 . "<AND")
                        (0 . "*POLYLINE")
                        (-4 . "&=")
                        (70 . 1)
                        (-4 . "AND>")
                        (-4 . "OR>")
                       )
               )
     )
   (progn (repeat (setq i (sslength ss))
            (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
              (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
            )
            (if (eq *SWCC:Opt* "Crossing")
              (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                     (setq pts (mapcar 'vlax-safearray->list (list a b)))
                     (if (setq tempC (ssget "_C"
                                            (list (caar pts) (cadar pts) 0.)
                                            (list (caadr pts) (cadadr pts) 0.)
                                     )
                         )
                       (repeat (setq i3 (sslength tempC))
                         (if (vlax-invoke
                               o
                               'Intersectwith
                               (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                               acExtendNone
                             )
                           (ssadd ec add)
                         )
                       )
                     )
              )
            )
          )
          (sssetfirst nil add)
          (ssget "_I")
   )
 )
 (princ)
)

(setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i))))) '((0 . "INSERT") (66 . 1))))

(defun c:CreateNestedLWPolyline (/ e new)
 (if (and
       (setq e (nentselp "\nSelect nested LWPolyline: "))
       (eq (length e) 4)
       (eq (cdr (assoc 0 (entget (car e)))) "LWPOLYLINE")
       (setq new (entmakex (entget (car e))))
     )
   (vla-transformby (vlax-ename->vla-object new) (vlax-tmatrix (caddr e)))
 )
 (princ)
)
(vl-load-com)
(princ)

(command "_.ncopy" "\" "" "_non" '(0 0) "_non" '(0 0))
((/ _pac add ss i e temp it o a b pts tempC i3 ec)
 ;; Select Within/Crossing Curve
 (vl-load-com)
 (defun _pac (e / l v d lst)
   (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
   (while (< (setq d (+ d v)) l)
     (setq lst (cons (trans (vlax-curve-getPointAtDist e d) 0 1) lst))
   )
 )
 (initget 0 "Crossing Within")
 (setq *SWCC:Opt*
        (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                 (cond (*SWCC:Opt*)
                                       ((setq *SWCC:Opt* "Crossing"))
                                 )
                                 ">: "
                         )
               )
              )
              (*SWCC:Opt*)
        )
 )
 (princ "\nSelect closed curves to select object(s) within: ")
 (if (setq add (ssadd)
           ss  (ssget '((-4 . "<OR")
                        (0 . "CIRCLE,ELLIPSE")
                        (-4 . "<AND")
                        (0 . "*POLYLINE")
                        (-4 . "&=")
                        (70 . 1)
                        (-4 . "AND>")
                        (-4 . "OR>")
                       )
               )
     )
   (progn (repeat (setq i (sslength ss))
            (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
              (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
            )
            (if (eq *SWCC:Opt* "Crossing")
              (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                     (setq pts (mapcar 'vlax-safearray->list (list a b)))
                     (if (setq tempC (ssget "_C"
                                            (list (caar pts) (cadar pts) 0.)
                                            (list (caadr pts) (cadadr pts) 0.)
                                     )
                         )
                       (repeat (setq i3 (sslength tempC))
                         (if (vlax-invoke
                               o
                               'Intersectwith
                               (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                               acExtendNone
                             )
                           (ssadd ec add)
                         )
                       )
                     )
              )
            )
          )
          (sssetfirst nil add)
          (ssget "_I")
   )
 )
 (princ)
)

example
(setq ss (ssget "X" '((cons 0 "insert")(cons 8 "Duct")(cons 410 "Model")(cons 41 1))))

; By Alan H may 2013
(vl-load-com)
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
) ; end defun
; program starts here
; choose output file change acdatemp to what you want
(setq fname (strcat "c:/alan/" (getstring "\nEnter file name ")))
(setq fout (open fname "w"))
(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)
(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
(co-ords2xy)
; write pline co-ords here
(setq numb3 (length co-ords))
(setq z numb3)
(setq ansco-ords "")
(repeat numb3 
(setq ansco-ords (strcat ansco-ords (rtos (nth (setq z (- z 1)) co-ords) 2 3 ) " " ))
)
(setq ans (strcat "Pline " ansco-ords))
(write-line ans fout)
(setq ansco-ords "")
(setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil) 
(princ "\nnothing inside")
(progn 
(setq coordsxy nil) ; reset for next time
(setq numb2 (sslength ss))
(setq y numb2)
(repeat numb2
(setq anstext (vlax-get-property (vlax-ename->vla-object (ssname ss (setq y (- y 1)))) "Textstring"))
(princ anstext) ; change to write text to file
(write-line (strcat "text " anstext) fout)
(princ "\n")
) ; end repeat2
(setq ss nil) ; reset for next poly
)
)
) ; end repeat1
(close fout)
(princ)