[编程交流] MatchCenInsPoly。lsp

; Method for selecting the polys:
; Simplier: with "entsel"
; Harder: with "ssget" method
; Get individual bounding box for each object (pline)
; Get individual bounding box for each selection inside each object
; Possible problems:
; (princ "\nYou must select polyline")
; (princ "\nThe polyline must be closed")
; (princ (strcat "\nThere are " (sslength ss) " selected open polylines, removing them from selection. "))
; null selection inside a closed poly
; Current problem, first theres selection "sel-polys", then theres selection "inside-sel":
(defun c:test ( / ent-ply sel-polys inside-sel box-polys box-insidesel reg pl_obj pt_lst_cnt pt_lst )
; To select plines only
(setq entitytype "*POLYLINE")
(if 
        (and (princ "\nSelect slots (closed polylines)") (setq sel-polys ((ssget "_:L")(list (cons 0 entitytype)))) 
        );and
        ; Repeat this for each polyline in the selection :
        (repeat 
                (setq idx (sslength sel-polys))
                (setq ent-ply (ssname sel-polys (setq idx (1- idx))))
                (setq box-polys (LM:ssboundingbox (vlax-ename->vla-object ent-ply )) )
                
                (cond 
                        
                        ; To check if the poly is closed:
                        (  (not
                                (vlax-property-available-p
                                        (setq obj (vlax-ename->vla-object ent-ply)) 'Area
                                )
                        )
                        (princ "\n** Invalid Object Selected **")
                        )
                        
                        ; Construct the region to get the centroid for poly:
                        ( (vl-catch-all-error-p
                                (setq reg
                                        (vl-catch-all-apply 'vlax-invoke
                                                (list
                                                        (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                                                                (if (= 1 (getvar 'cvport))
                                                                        'paperspace
                                                                        'modelspace
                                                                )
                                                        )
                                                        'addregion (list (vlax-ename->vla-object ent-ply ))
                                                )
                                        )
                                )
                        )
                        
                        (princ "\nUnable to create region from boundary.")
                        )
                        
                        ; Get the objects inside the closed polyline "inside-sel" :
                        ( (setq        pl_obj (vlax-ename->vla-object ent-ply) cc (vla-get-Coordinates pl_obj))
                                (setq        pt_lst_cnt (/        (length (vlax-safearray->list (vlax-variant-value cc))) 2 ))
                                (setq cntr 0)
                                (repeat pt_lst_cnt
                                        (setq pt_lst (cons (vlax-safearray->list (vlax-variant-value (vla-get-Coordinate pl_obj cntr))) pt_lst ) cntr (1+ cntr))
                                );repeat
                                (setq inside-sel (ssget "_WP" pt_lst ))
                                       ;(sssetfirst nil inside-sel) ;<- DO I NEED TO DISSELECT "sel-polys" ???
                        )
                        
                        ; Get the "inside-sel" bounding box:                                
                        (   (not (setq box-insidesel (LM:ssboundingbox inside-sel)))
                                (princ "\nUnable to calculate bounding box for selection.")
                        )
                        
                        ; Check if "inside-sel" is empty
                        ; Move the "inside-sel" objects inside the polyline, from their centroid, to match the poly's centroid:
                        ( (not (null inside-sel))
                                (vl-cmdf "_.move" inside-sel ""
                                        "_non" (trans (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box-insidesel)) 0 1)
                                        "_non" (vlax-get (car reg) 'centroid)
                                );vl-cmdf
                                (princ "\nThe polyline is empty nothing selected ")
                        )
                );cond
                
        ); end of repeat
);if
(princ)
);defun
;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
        (if
                (and
                        (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                        (vlax-method-applicable-p o 'getboundingbox)
                        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
                )
                (setq m (cons (vlax-safearray->list a) m)
                        n (cons (vlax-safearray->list b) n)
                )
        )
)
(if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(vl-load-com) (princ)        

(defun c:test ( / b e i l m s x )
   (if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
       (repeat (setq i (sslength s))
           (setq e (ssname s (setq i (1- i)))
                 l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)))
           )
           (if (and (setq m (ssget "_WP" l))
                    (or (not (ssmemb e m)) (ssdel e m))
                    (< 0 (sslength m))
                    (setq b (LM:ssboundingbox m))
               )
               (vl-cmdf "_.move" m ""
                   "_non" (trans (LM:listmid b) 0 1)
                   "_non" (trans (LM:listmid l) e 1)
               )
           )
       )
   )
   (princ)
)
(defun LM:listmid ( lst )
   ((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)
               
;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
   (repeat (setq i (sslength s))
       (if
           (and
               (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
               (vlax-method-applicable-p o 'getboundingbox)
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
           )
           (setq m (cons (vlax-safearray->list a) m)
                 n (cons (vlax-safearray->list b) n)
           )
       )
   )
   (if (and m n)
       (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
   )
)
(vl-load-com) (princ)