[编程交流] 按clic对实体排序和编号

;; OE (Order Entities)  -  Lee Mac
(defun LEEoe ( ent / cnt  enx new sbx sub )
   (setq cnt 1)
   ;(while
       (progn
           (setvar 'errno 0)
           ;(setq ent (car (entsel (strcat "\nSelect object " (itoa cnt) " <done>: "))))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent)
                   nil
               )
               (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (setq enx (entget ent)))))))))
                   (princ "\nSelected object is on a locked layer.")
               )
               (   (and
                       (setq new (entmakex enx))
                       (or (/= 1 (cdr (assoc 66 enx)))
                           (progn
                               (setq sub (entnext ent)
                                     sbx (entget  sub)
                               )
                               (while (/= "SEQEND" (cdr (assoc 0 sbx)))
                                   (entmake sbx)
                                   (setq sub (entnext sub)
                                         sbx (entget  sub)
                                   )
                               )
                               (entmake sbx)
                           )
                       )
                   )
                   (entdel ent)
                   (redraw new 3)
                   (setq   cnt (1+ cnt))
               )
               (   (princ "\nUnable to reorder selected object."))
           )
       )
;    ) ; while
   
   (princ)
)
; pline co-ords example
; By Alan H
(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 len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(defun c:OE( / ss x)
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)
(setq co-ords (getcoords (entlast)))
(co-ords2xy) ; list of 2d points making pline
(entdel (entlast))
(setq ss (ssget "F" co-ordsxy))
(setq x (sslength ss))
(repeat (sslength ss)
(setq ent (ssname ss (setq x ( - x 1))))
(if (= (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))) "AcDbCircle")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-center obj))) )
(setq ts (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
 (if (zerop ts)
     (command "TEXT" pt "3.5" "0" (rtos x 2 0))
     (command "TEXT" pt "0" (rtos x 2 0))
  )      
) ; progn
) ; if 
(LEEoe ent)
(princ "\n")
)
(command "_.regen")
)