[编程交流] 在铝的两端放置砌块

(defun-q C:BlockOnBothEndsOfLine nil
 ( '( ( f L ) (if L (apply (function f) (cons 0 L))))
   '( (i a b c / tmp)
     (and
       (setq tmp (ssname b i))
       (setq tmp (entget tmp))
       (mapcar ''( (x) (vlax-invoke c 'InsertBlock (cdr (assoc x tmp)) a 1 1 1 0)) '(10 11))
       (f (1+ i) a b c)
     )
   )
   ( '( (f L / tmp) (if (= (length L) (length (setq tmp (f L)))) tmp))
     '( ( L / tmp ) (if (and L (setq tmp (eval (car L)))) (cons tmp (f (cdr L)))) )
     '(
       ('((v) (if (and v (member '(0 . "INSERT") (entget v)))  (vla-get-EffectiveName (vlax-ename->vla-object v)))) (car (entsel "\nPick the block: ")))
       (progn (princ "\nSelect the lines: ") (ssget '((0 . "LINE"))))
       ( '((f)(f (vlax-get-acad-object) (reverse '(Block ActiveLayout ActiveDocument))))
         (lambda ( o L / tmp) (if (setq tmp (car L))  (f (vlax-get o tmp) (cdr L)) o ))
       )
     )
   )
 )
 (princ)
)

(defun c:foo (/ e o s tmp)
 (if (and (setq e (car (entsel "\nSelect a block to copy: ")))
   (vlax-write-enabled-p (setq o (vlax-ename->vla-object e)))
   (vlax-property-available-p o 'insertionpoint)
   (setq s (ssget '((0 . "line"))))
     )
   (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (mapcar '(lambda (x)
         (and (not (vl-position x tmp))
              (setq tmp (cons x tmp))
              (setq o (vla-copy o))
              (vlax-put o 'insertionpoint x)
         )
       )
      (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
     )
   )
 )
 (princ)
)
(vl-load-com)

(defun c:test (/ pck sel int ent get bnm)
 (and
   (setq pck (car (entsel "\nPick on the target block :")))
   (or (and (= (cdr (assoc 0 (setq get (entget pck)))) "INSERT")
            (null (assoc 66 get))
       )
       (alert "Invalid object. Try again.<!>")
   )
   (princ
     (strcat "\nSelect Polyline/Line(s) to place <"
             (setq bnm (vla-get-effectivename (vlax-ename->vla-object pck)))
             "> at their Endpoints :"
     )
   )
   (setq int -1
         sel (ssget '((0 . "LINE,LWPOLYLINE")))
   )
   (while (setq ent (ssname sel (setq int (1+ int))))
     (foreach p (list (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent))
       (entmake (list '(0 . "INSERT") (cons 2 bnm) (cons 10 (trans p 0 1))))
     )
   )
 )
 (princ)
) (vl-load-com)