收藏73哥程序，链式选择相交圆

树櫴希德 · 发表于 2024-5-15 15:00:35

选择集包围盒 by @[x_s_s_1]生无可恋大神

(defun testss (ss / lst lst1 maxx maxy minx miny n pt1 pt2)
(repeat (setq n (sslength ss))
(setq lst (cons (vlax-ename->vla-object
(ssname ss (setq n (1- n))))
lst)))
(setq lst (mapcar '(lambda (x)
(vla-getboundingbox x 'pt1 'pt2)
(list (vlax-safearray->list pt1)
(vlax-safearray->list pt2)))
lst)
lst (apply 'append lst)
lst1 (mapcar 'car lst)
lst (mapcar 'cadr lst)
minx (apply 'min lst1)
maxx (apply 'max lst1)
miny (apply 'min lst)
maxy (apply 'max lst))
(list minx maxx miny maxy))
(setq a (testss (setq ss (ssget))))
;|(command "point" (list (* 0.5 (+ (car a) (cadr a))) (* 0.5 (+ (caddr a) (cadddr a)))))|;
(command "point" (list (* 0.5 (+ (car a) (cadr a))) (* 0.5 (+ (caddr a) (cadddr a)))))
(command "rectangle" (list (car a )( caddr a)) (list (cadr a )( cadddr a)) )

(defun testss  (ss / lst lst1 maxx maxy minx miny n pt1 pt2) 
    (repeat (setq n (sslength ss)) 
  (setq lst (cons  (vlax-ename->vla-object 
          (ssname ss (setq n (1- n)))) 
      lst))) 
    (setq lst  (mapcar '(lambda  (x) 
          (vla-getboundingbox x 'pt1 'pt2) 
          (list (vlax-safearray->list pt1) 
          (vlax-safearray->list pt2))) 
           lst) 
    lst  (apply 'append lst) 
    lst1 (mapcar 'car lst) 
    lst  (mapcar 'cadr lst) 
    minx (apply 'min lst1) 
    maxx (apply 'max lst1) 
    miny (apply 'min lst) 
    maxy (apply 'max lst)) 
    (list minx maxx miny maxy)) 
(setq a (testss (setq ss (ssget)))) 
;|(command "point"     (list (* 0.5 (+ (car a) (cadr a)))          (* 0.5 (+ (caddr a) (cadddr a)))))|; 
   (command "point"     (list (* 0.5 (+ (car a) (cadr a)))          (* 0.5 (+ (caddr a) (cadddr a))))) 
 
  (command "rectangle" (list (car a )( caddr a))  (list (cadr a )( cadddr a))   )

树櫴希德 · 发表于 2024-5-29 21:57:41

(VL-LOAD-COM)
(vla-update (vla-Move (vlax-ename->vla-object (car(nentsel)))(vlax-3d-point (getpoint ) )(vlax-3d-point (getpoint ) ) ))

树櫴希德 · 发表于 2024-6-10 16:49:05

如何获取系统的屏幕分辨率设置值？谢谢
@Koz @必强感谢两位大佬！

(Defun vlsys-GetScreenResolution (/ w h wmi meth1 meth2 n)
(if (setq wmi (vlax-create-object "WbemScripting.SWbemLocator"))
(progn
(setq meth1 (vlax-invoke wmi 'ConnectServer)
meth2 (vlax-invoke
meth1 'ExecQuery
"Select * from Win32_VideoController"
"WQL" 48
)
)
(vlax-for n meth2
(setq w (vlax-get n 'CurrentVerticalResolution)
h (vlax-get n 'CurrentHorizontalResolution)
)
)
(mapcar 'vlax-release-object (list wmi meth1 meth2))
)
)
(list w h)
)
(Defun vldcl-GetScreenResolutionByH51 (/ VLO)
(setq vlo (vlax-get-property
(vlax-get-property
(vlax-get-or-Create-Object "HtmlFile")
"ParentWindow"
)
"Screen"
)
)
(mapcar '(lambda (x) (vlax-get-property vlo x))
'("width" "height" "logicalXDPI" "logicalYDPI")
)
)

(Defun vlsys-GetScreenResolution (/ w h wmi meth1 meth2 n) 
  (if (setq wmi (vlax-create-object "WbemScripting.SWbemLocator")) 
    (progn 
      (setq meth1 (vlax-invoke wmi 'ConnectServer) 
        meth2 (vlax-invoke 
            meth1 'ExecQuery 
        "Select * from Win32_VideoController" 
        "WQL" 48 
           ) 
      ) 
      (vlax-for    n meth2 
    (setq w    (vlax-get n 'CurrentVerticalResolution) 
          h    (vlax-get n 'CurrentHorizontalResolution) 
    ) 
      ) 
      (mapcar 'vlax-release-object (list wmi meth1 meth2)) 
    ) 
  ) 
   (list w h) 
) 
 
(Defun vldcl-GetScreenResolutionByH51 (/ VLO) 
  (setq    vlo (vlax-get-property 
          (vlax-get-property 
        (vlax-get-or-Create-Object "HtmlFile") 
        "ParentWindow" 
          ) 
          "Screen" 
        ) 
  ) 
  (mapcar '(lambda (x) (vlax-get-property vlo x)) 
      '("width" "height" "logicalXDPI" "logicalYDPI") 
  ) 
)

树櫴希德 · 发表于 2024-7-22 18:14:38

BY `@[x_s_s_1]生无可恋大神
定数等分长方体

(defun c:tt (/ en n dis pt1 pt2)
(setq en (car (entsel))
n (getint "\n等分数:")
)
(vla-getboundingbox (vlax-ename->vla-object en) 'pt1 'pt2)
(setq dis (- (car (vlax-safearray->list pt2))
(car (vlax-safearray->list pt1))
)
dis (/ dis n)
)
(command "copy" en "" "none" '(0 0) "none" (list dis 0))
(command "subtract" en "" (entlast) "")
(repeat (1- n)
(command "copy" en "" "none" '(0 0) "none" (list dis 0))
(setq en (entlast))
)
)

树櫴希德 · 发表于 2024-9-6 15:50:51

;;对原有命令进行修改,支持系统命令
(defun c:xml (/ a b)
(setq a(getstring"\n输入原有快捷命令")
b(getstring"\n输入新的快捷命令"))
(eval(read(strcat "(defun c:"b
"()(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) ""a
"\n\")
)")))
)

树櫴希德 · 发表于 2024-9-30 21:01:37

LM向块内添加实体

;;----------------------=={ Add Objects to Block }==--------------------;;
;; ;;
;; This program enables the user to add a selection of objects to the ;;
;; definition of a selected block. ;;
;; ;;
;; Upon issuing the command syntax 'addtoblock' at the AutoCAD ;;
;; command line, the program prompts the user for a selection of ;;
;; objects residing on unlocked layers to be added to a chosen block ;;
;; definition. ;;
;; ;;
;; Following a valid selection, the program prompts the user to select ;;
;; a reference of a block whose definition is to be modified to ;;
;; incorporate all objects in the selection. ;;
;; ;;
;; At this prompt, the program will permit selection of any standard ;;
;; (non-dynamic) uniformly scaled block reference which is not ;;
;; referenced within the selection (as a block reference cannot be ;;
;; added to its own definition). ;;
;; ;;
;; Every object in the selection will then be transformed relative to ;;
;; the position, scale, rotation, and orientation of the selected ;;
;; block reference, before being copied to the definition of the ;;
;; block and removed from the drawing. ;;
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
;; Version 1.1 - 2011-05-31 ;;
;; ;;
;; - First release. ;;
;;----------------------------------------------------------------------;;
;; Version 1.2 - 2020-11-15 ;;
;; ;;
;; - Program completely rewritten to incorporate a check for ;;
;; references of the target block within the selected objects. ;;
;;----------------------------------------------------------------------;;
(defun c:addtoblock ( / *error* bln bnl btr def ent enx idx lst sel tmp )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(LM:startundo (LM:acdoc))
(cond
( (not (setq sel (LM:ssget "\nSelect objects to add to block: " '("_")))))
( (progn
(repeat (setq idx (sslength sel))
(setq idx (1- idx)
ent (ssname sel idx)
enx (entget ent)
lst (cons (vlax-ename->vla-object ent) lst)
)
(if (and (= "INSERT" (cdr (assoc 0 enx)))
(not (member (setq bln (strcase (cdr (assoc 2 enx)))) bnl))
)
(setq bnl (cons bln bnl))
)
)
(while (setq def (tblnext "block" (not def)))
(setq ent (tblobjname "block" (cdr (assoc 2 def))))
(while (setq ent (entnext ent))
(if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
(setq tmp (cons (strcase (cdr (assoc 2 enx))) tmp))
)
)
(if tmp
(setq btr (cons (cons (strcase (cdr (assoc 2 def))) tmp) btr)
tmp nil
)
)
)
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent)
nil
)
( (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
(princ "\nThe selected object is not a block.")
)
( (not
(and
(equal (abs (cdr (assoc 41 enx))) (abs (cdr (assoc 42 enx))) 1e-8)
(equal (abs (cdr (assoc 41 enx))) (abs (cdr (assoc 43 enx))) 1e-8)
)
)
(princ "\nThis program is not currently compatible with non-uniformly scaled blocks - sorry.")
)
( (= :vlax-true (vla-get-isdynamicblock (vlax-ename->vla-object ent)))
(princ "\nThis program is not currently compatible with dynamic blocks - sorry.")
)
( (vl-some '(lambda ( bln ) (member bln bnl))
(
(lambda ( / rtn )
(setq bln (strcase (cdr (assoc 2 enx))))
(foreach def btr
(cond
( (= bln (car def)))
( (member (car def) rtn))
( (addtoblock:referenced-p bln (cdr def) btr) (setq rtn (cons (car def) rtn)))
)
)
(cons bln rtn)
)
)
)
(princ "\nThe selected block is referenced by a block in the selection.")
)
)
)
)
ent
)
( (lambda ( mat )
(foreach obj lst (vla-transformby obj mat))
(vla-copyobjects (LM:acdoc)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
(vla-item (vla-get-blocks (LM:acdoc)) (cdr (assoc 2 (entget ent))))
)
(foreach obj lst (vla-delete obj))
(vla-regen (LM:acdoc) acallviewports)
)
(apply
(function
(lambda ( mat vec )
(vlax-tmatrix
(append
(mapcar
(function
(lambda ( x v )
(append x (list v))
)
)
mat vec
)
'((0.0 0.0 0.0 1.0))
)
)
)
)
(revrefgeom ent)
)
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)
(defun addtoblock:referenced-p ( bln def lst )
(or (member bln def)
(vl-some '(lambda ( nst ) (addtoblock:referenced-p bln (cdr (assoc nst lst)) lst)) def)
)
)
;; RevRefGeom (gile)
;; The inverse of RefGeom
(defun revrefgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(list
(list (/ 1.0 (cdr (assoc 41 enx))) 0.0 0.0)
(list 0.0 (/ 1.0 (cdr (assoc 42 enx))) 0.0)
(list 0.0 0.0 (/ 1.0 (cdr (assoc 43 enx))))
)
(mxm
(list
(list (cos ang) (sin ang) 0.0)
(list (- (sin ang)) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar '(lambda ( v ) (trans v ocs 0 t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
)
)
)
(mapcar '- (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
(mxv mat (trans (cdr (assoc 10 enx)) ocs 0))
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: AddObjectsToBlock.lsp | Version 1.2 | \\U+00A9 Lee Mac "
((lambda ( y ) (if (= y (menucmd "m=$(edtime,0,yyyy)")) y (strcat y "-" (menucmd "m=$(edtime,0,yyyy)")))) "2011")
" www.lee-mac.com ::"
"\n:: Type \"addtoblock\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

;;----------------------=={ Add Objects to Block }==--------------------;; 
;;                                                                      ;; 
;;  This program enables the user to add a selection of objects to the  ;; 
;;  definition of a selected block.                                     ;; 
;;                                                                      ;; 
;;  Upon issuing the command syntax 'addtoblock' at the AutoCAD         ;; 
;;  command line, the program prompts the user for a selection of       ;; 
;;  objects residing on unlocked layers to be added to a chosen block   ;; 
;;  definition.                                                         ;; 
;;                                                                      ;; 
;;  Following a valid selection, the program prompts the user to select ;; 
;;  a reference of a block whose definition is to be modified to        ;; 
;;  incorporate all objects in the selection.                           ;; 
;;                                                                      ;; 
;;  At this prompt, the program will permit selection of any standard   ;; 
;;  (non-dynamic) uniformly scaled block reference which is not         ;; 
;;  referenced within the selection (as a block reference cannot be     ;; 
;;  added to its own definition).                                       ;; 
;;                                                                      ;; 
;;  Every object in the selection will then be transformed relative to  ;; 
;;  the position, scale, rotation, and orientation of the selected      ;; 
;;  block reference, before being copied to the definition of the       ;; 
;;  block and removed from the drawing.                                 ;; 
;;----------------------------------------------------------------------;; 
;;  Author:  Lee Mac, Copyright ?2011  -  <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>              ;; 
;;----------------------------------------------------------------------;; 
;;  Version 1.1    -    2011-05-31                                      ;; 
;;                                                                      ;; 
;;  - First release.                                                    ;; 
;;----------------------------------------------------------------------;; 
;;  Version 1.2    -    2020-11-15                                      ;; 
;;                                                                      ;; 
;;  - Program completely rewritten to incorporate a check for           ;; 
;;    references of the target block within the selected objects.       ;; 
;;----------------------------------------------------------------------;; 
 
(defun c:addtoblock ( / *error* bln bnl btr def ent enx idx lst sel tmp ) 
 
    (defun *error* ( msg ) 
        (LM:endundo (LM:acdoc)) 
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) 
            (princ (strcat "\nError: " msg)) 
        ) 
        (princ) 
    ) 
 
    (LM:startundo (LM:acdoc)) 
    (cond 
        (   (not (setq sel (LM:ssget "\nSelect objects to add to block: " '("_<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />"))))) 
        (   (progn 
                (repeat (setq idx (sslength sel)) 
                    (setq idx (1- idx) 
                          ent (ssname sel idx) 
                          enx (entget ent) 
                          lst (cons (vlax-ename->vla-object ent) lst) 
                    ) 
                    (if (and (= "INSERT" (cdr (assoc 0 enx))) 
                             (not (member (setq bln (strcase (cdr (assoc 2 enx)))) bnl)) 
                        ) 
                        (setq bnl (cons bln bnl)) 
                    ) 
                ) 
                (while (setq def (tblnext "block" (not def))) 
                    (setq ent (tblobjname "block" (cdr (assoc 2 def)))) 
                    (while (setq ent (entnext ent)) 
                        (if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) 
                            (setq tmp (cons (strcase (cdr (assoc 2 enx))) tmp)) 
                        ) 
                    ) 
                    (if tmp 
                        (setq btr (cons (cons (strcase (cdr (assoc 2 def))) tmp) btr) 
                              tmp nil 
                        ) 
                    ) 
                ) 
                (while 
                    (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block: "))) 
                        (cond 
                            (   (= 7 (getvar 'errno)) 
                                (princ "\nMissed, try again.") 
                            ) 
                            (   (null ent) 
                                nil 
                            ) 
                            (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) 
                                (princ "\nThe selected object is not a block.") 
                            ) 
                            (   (not 
                                    (and 
                                        (equal (abs (cdr (assoc 41 enx))) (abs (cdr (assoc 42 enx))) 1e-8) 
                                        (equal (abs (cdr (assoc 41 enx))) (abs (cdr (assoc 43 enx))) 1e-8) 
                                    ) 
                                ) 
                                (princ "\nThis program is not currently compatible with non-uniformly scaled blocks - sorry.") 
                            ) 
                            (   (= :vlax-true (vla-get-isdynamicblock (vlax-ename->vla-object ent))) 
                                (princ "\nThis program is not currently compatible with dynamic blocks - sorry.") 
                            ) 
                            (   (vl-some '(lambda ( bln ) (member bln bnl)) 
                                    ( 
                                        (lambda ( / rtn ) 
                                            (setq bln (strcase (cdr (assoc 2 enx)))) 
                                            (foreach def btr 
                                                (cond 
                                                    (   (= bln (car def))) 
                                                    (   (member (car def) rtn)) 
                                                    (   (addtoblock:referenced-p bln (cdr def) btr) (setq rtn (cons (car def) rtn))) 
                                                ) 
                                            ) 
                                            (cons bln rtn) 
                                        ) 
                                    ) 
                                ) 
                                (princ "\nThe selected block is referenced by a block in the selection.") 
                            ) 
                        ) 
                    ) 
                ) 
                ent 
            ) 
            (   (lambda ( mat ) 
                    (foreach obj lst (vla-transformby obj mat)) 
                    (vla-copyobjects (LM:acdoc) 
                        (vlax-make-variant 
                            (vlax-safearray-fill 
                                (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) 
                                lst 
                            ) 
                        ) 
                        (vla-item (vla-get-blocks (LM:acdoc)) (cdr (assoc 2 (entget ent)))) 
                    ) 
                    (foreach obj lst (vla-delete obj)) 
                    (vla-regen (LM:acdoc) acallviewports) 
                ) 
                (apply 
                    (function 
                        (lambda ( mat vec ) 
                            (vlax-tmatrix 
                                (append 
                                    (mapcar 
                                        (function 
                                            (lambda ( x v ) 
                                                (append x (list v)) 
                                            ) 
                                        ) 
                                        mat vec 
                                    ) 
                                   '((0.0 0.0 0.0 1.0)) 
                                ) 
                            ) 
                        ) 
                    ) 
                    (revrefgeom ent) 
                ) 
            ) 
        ) 
    ) 
    (LM:endundo (LM:acdoc)) 
    (princ) 
) 
 
(defun addtoblock:referenced-p ( bln def lst ) 
    (or (member bln def) 
        (vl-some '(lambda ( nst ) (addtoblock:referenced-p bln (cdr (assoc nst lst)) lst)) def) 
    ) 
) 
 
;; RevRefGeom (gile) 
;; The inverse of RefGeom 
 
(defun revrefgeom ( ent / ang enx mat ocs ) 
    (setq enx (entget ent) 
          ang (cdr (assoc 050 enx)) 
          ocs (cdr (assoc 210 enx)) 
    ) 
    (list 
        (setq mat 
            (mxm 
                (list 
                    (list (/ 1.0 (cdr (assoc 41 enx))) 0.0 0.0) 
                    (list 0.0 (/ 1.0 (cdr (assoc 42 enx))) 0.0) 
                    (list 0.0 0.0 (/ 1.0 (cdr (assoc 43 enx)))) 
                ) 
                (mxm 
                    (list 
                        (list (cos ang)     (sin ang) 0.0) 
                        (list (- (sin ang)) (cos ang) 0.0) 
                       '(0.0 0.0 1.0) 
                    ) 
                    (mapcar '(lambda ( v ) (trans v ocs 0 t)) 
                        '( 
                             (1.0 0.0 0.0) 
                             (0.0 1.0 0.0) 
                             (0.0 0.0 1.0) 
                         ) 
                    ) 
                ) 
            ) 
        ) 
        (mapcar '- (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))) 
            (mxv mat (trans (cdr (assoc 10 enx)) ocs 0)) 
        ) 
    ) 
) 
 
;; Matrix Transpose  -  Doug Wilson 
;; Args: m - nxn matrix 
 
(defun trp ( m ) 
    (apply 'mapcar (cons 'list m)) 
) 
 
;; Matrix x Matrix  -  Vladimir Nesterovsky 
;; Args: m,n - nxn matrices 
 
(defun mxm ( m n ) 
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) 
) 
 
;; Matrix x Vector  -  Vladimir Nesterovsky 
;; Args: m - nxn matrix, v - vector in R^n 
 
(defun mxv ( m v ) 
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) 
) 
 
;; ssget  -  Lee Mac 
;; A wrapper for the ssget function to permit the use of a custom selection prompt 
;; msg - [str] selection prompt 
;; arg - [lst] list of ssget arguments 
 
(defun LM:ssget ( msg arg / sel ) 
    (princ msg) 
    (setvar 'nomutt 1) 
    (setq sel (vl-catch-all-apply 'ssget arg)) 
    (setvar 'nomutt 0) 
    (if (not (vl-catch-all-error-p sel)) sel) 
) 
 
;; Start Undo  -  Lee Mac 
;; Opens an Undo Group. 
 
(defun LM:startundo ( doc ) 
    (LM:endundo doc) 
    (vla-startundomark doc) 
) 
 
;; End Undo  -  Lee Mac 
;; Closes an Undo Group. 
 
(defun LM:endundo ( doc ) 
    (while (= 8 (logand 8 (getvar 'undoctl))) 
        (vla-endundomark doc) 
    ) 
) 
 
;; Active Document  -  Lee Mac 
;; Returns the VLA Active Document Object 
 
(defun LM:acdoc nil 
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) 
    (LM:acdoc) 
) 
 
;;----------------------------------------------------------------------;; 
 
(vl-load-com) 
(princ 
    (strcat 
        "\n:: AddObjectsToBlock.lsp | Version 1.2 | \\U+00A9 Lee Mac " 
        ((lambda ( y ) (if (= y (menucmd "m=$(edtime,0,yyyy)")) y (strcat y "-" (menucmd "m=$(edtime,0,yyyy)")))) "2011") 
        " <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a> ::" 
        "\n:: Type \"addtoblock\" to Invoke ::" 
    ) 
) 
(princ) 
 
;;----------------------------------------------------------------------;; 
;;                             End of File                              ;; 
;;----------------------------------------------------------------------;;

账号		自动登录	找回密码
密码			注册