[编程交流] Lisp动态块（&D）

REMOVED

(defun c:LongWall (/ blockname p1 p2)
 ;; Insert and array "LONG WALL" block (required)
 ;; Alan J. Thompson, 05.05.10
 (vl-load-com)
 (setq blockname "LONG WALL")
 (if (and (or (tblsearch "block" blockname)
              (findfile (strcat blockname ".dwg"))
              (alert (strcat blockname " cannot be found!"))
          )
          (setq p1 (getpoint "\nSpecify block insertion point: "))
          (setq p2 (getpoint p1 "\nSpecify block end point: "))
     )
   ((lambda (block)
      (foreach x (vlax-invoke block 'GetDynamicBlockProperties)
        (and (eq (vla-get-propertyname x) "Distance")
             (vla-put-value
               x
               ((lambda (dist / num)
                  (cond
                    ((>= 1. (/ dist 46.)) 46.)
                    ((< 1. (setq num (/ dist 46.))) (* 46. (1+ (fix num))))
                    (46.)
                  )
                )
                 (distance p1 p2)
               )
             )
        )
      )
      (vl-catch-all-apply (function (lambda () (vla-explode block) (vla-delete block))))
    )
     (vla-insertblock
       (if
         (or (eq acmodelspace
                 (vla-get-activespace
                   (cond (*AcadDoc*)
                         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                   )
                 )
             )
             (eq :vlax-true (vla-get-mspace *AcadDoc*))
         )
          (vla-get-modelspace *AcadDoc*)
          (vla-get-paperspace *AcadDoc*)
       )
       (vlax-3d-point (trans p1 1 0))
       blockname
       1.
       1.
       1.
       (angle (trans p1 1 0) (trans p2 1 0))
     )
   )
 )
 (princ)
)