[编程交流] 使用lisp或vba放置对象

;;hm.lsp
(defun group-by-num (lst num / ls ret)
 (if (= (rem (length lst) num ) 0)
   (progn
     (setq ls nil)
     (repeat (/ (length lst) num)
(repeat num (setq ls 
            (cons (car lst) ls)
      lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
      ls nil)))
   )
ret
 )
;;holes markers
(defun C:hm (/ acsp adoc axss bpt cnt en ipt obj oline points ss wid)
 (or adoc
     (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
     )
 )
 (or acsp
     (setq acsp
     (vla-get-block
       (vla-get-activelayout adoc)
     )
     )
 )
 (setq wid 6.5515)
 (if (and (setq ss (ssget '((0 . "LWPOLYLINE,LINE")(8 . "0"))));;select objects on layer "0"
      (setq en (entsel "\nSelect Intersecting Line > ")))
   (progn
     (setq axss (vla-get-activeselectionset adoc)
    oline (vlax-ename->vla-object (car en))
    )
     (vlax-for obj axss
(if (not (vl-catch-all-error-p
           (setq ipt (vl-catch-all-apply
             (function (lambda()
                (vlax-invoke obj 'IntersectWith oline acextendnone))))))
         )
  (if (= (length ipt) 3)
  (setq points (append (list ipt) points))
  (setq points (append (group-by-num ipt 3) points))  
    )))
     (setq points (vl-sort points (function (lambda(a b)(< (car a)(car b))))))
     (setq cnt 1)
     (while (setq ipt (car points))
     (if (= (rem cnt 2) 1)
       (setq ipt (list (- (car ipt) wid)(cadr ipt)(caddr ipt)))
       )
       (setq bpt (cons ipt bpt))
             (setq points (cdr points))
              (setq cnt (1+ cnt))
)
 (while (setq ipt (car bpt))
   (vlax-invoke acsp 'InsertBlock ipt "3ANSYMB" 1 1 1 0)
   (setq bpt (cdr bpt))
   )
     )
   )
 (princ)
 )
(vl-load-com)