[编程交流] 每行新图层

(vl-load-com) (princ)
; CountWithLayer reactor thats not full-proof.
(defun CountWithLayer:CB ( rtr args / o lyr f n )
 (cond 
   ( (not (and *Han* *Lyrs*)) (prompt "\n#1") )
   ( (vl-catch-all-error-p (setq lyr (vl-catch-all-apply 'vla-Item (list *Lyrs* (getvar 'clayer))))) (prompt "\n#2") )
   (
     (not 
       (setq o 
         ( ; alternative to (entlast) with ActiveX
           (lambda ( / spc r )
             (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
             (setq r (vl-catch-all-apply 'vla-Item (list spc (1- (vlax-get-property spc 'Count)))))
             (if (not (vl-catch-all-error-p r)) r)
           )
         )
       )
     ); not
     (prompt "\n#3")
   )
   ( (not (vlax-property-available-p o 'Layer)) (prompt "\n#4") )
   ( (eq o *lasto*) (prompt "\n#5") )
   ; ( (not (wcmatch (vlax-get-property *lasto* 'Layer) "cnt_*")) (prompt "\n#6") ) ; not perfect
   ; ( (not (eq (vlax-get-property lyr 'Name) (vlax-get-property *lasto* 'Layer))) (prompt "\n#6") )
   ( (not (setq f (eval (cdr (assoc (vlr-current-reaction-name) '((:VLR-objectAppended . 1+)(:VLR-ObjectErased . 1-)(:VLR-ObjectUnerased . 1+))))))) (prompt "\n#7") )
   ( (not (eq *Han* (vla-get-Handle lyr))) (prompt "\n#8") )
   ( (not (eq 'INT (type (setq n (read (vl-string-left-trim "cnt_" (vlax-get-property lyr 'Name))))))) (prompt "\n#9") )
   ( (not (vlax-write-enabled-p lyr)) (prompt "#10") )
   ( (vl-catch-all-apply 'vlax-put-property (list lyr 'Name (strcat "cnt_" (itoa (f n))))) ) ; duplicate layer name possibility
 ); cond
); defun CountWithLayer:CB 
( ; Note Layers that wcmatch to "cnt_*" must be erased
 (lambda ( rtrnm / e)
   (setq *Lyrs* (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
   (setq *Han* (vla-get-Handle (vla-Add *Lyrs* "cnt_0")))
   (and (setq e (entlast)) (setq *lasto* (vlax-ename->vla-object e)))
   (setvar 'clayer "cnt_0")
   (foreach rtr (cdar (vlr-reactors :VLR-AcDb-reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) )
   (vlr-set-Notification
     (vlr-AcDb-reactor rtrnm '((:VLR-objectAppended . CountWithLayer:cb)(:VLR-ObjectErased . CountWithLayer:cb)(:VLR-ObjectUnerased . CountWithLayer:cb)))
     'Active-Document-Only
   ); vlr-set-Notification
 ); lambda
 "MyTestReactor"
)

(defun c:foo (/ i n p1 p2 p3 s)
 (setq        i (cond        ((setq s (ssget "_x" '((0 . "line"))))
         (1+ (apply 'max
                    (mapcar '(lambda (x) (fix (atof (cdr (assoc 8 (entget x))))))
                            (mapcar 'cadr (ssnamex s))
                    )
             )
         )
        )
        (1)
  )
 )
 (while
   (progn
     (setq n 0)
     (while (and (or (setq p1 p3) (setq p1 (getpoint "\nSpecify first point: ")))
          (setq p2 (getpoint p1 "\nSpecify next point: "))
     )
(setq p3 nil)
(and (entmakex (list '(0 . "line")
                     (cons 10 p1)
                     (cons 11 p2)
                     (cons 8 (itoa i))
                     (cons 62
                           (if (= 0 (rem i 255))
                             1
                             (rem i 255)
                           )
                     )
               )
     )
     (setq n (1+ n))
     (princ (strcat "\nLine created on layer [" (itoa i) "]"))
)
     )
     (if
(setq p3 (getpoint (strcat "\nSpecify first point for next layer [" (itoa (+ n i)) "]: ")))
 (setq i (+ n i))
     )
   )
 )
 (princ)
)

  (setq        i (cond        ([color="red"](mapcar 'cadr (ssnamex (setq s (ssget "_x" '((0 . "line"))))))[/color] This will bomb if no selection is found.         (1+ (apply 'max                    (mapcar '(lambda (x) (fix (atof (cdr (assoc 8 (entget x))))))                            (mapcar 'cadr (ssnamex s))                    )             )         )        )        (1)  ) )