[编程交流] 比例法（替代

  
(defun C:SXYZ (/ SS IP XS YS ZS RA)
 (setvar "cmdecho" 0)
 (setq SS (ssget)
IP (getpoint "Enter Base point (temp. blockname 'xstemp' will be used :")
 ) ;_ end of setq
 (initget 6)
 (setq XS (getreal "Enter X scale factor <1>:"))
 (initget 6)
 (setq YS (getreal "Enter Y scale factor (default=X):"))
 (setq ZS (getreal "Enter Z scale factor (default=X):")
RA (getreal "Enter Rotation angle <0>:")
 ) ;_ end of setq
 (if (= XS NIL)
   (setq XS 1)
 ) ;_ end of if
 (if (= YS NIL)
   (setq YS XS)
 ) ;_ end of if
 (if (= ZS NIL)
   (setq ZS XS)
 ) ;_ end of if
 (if (= RA NIL)
   (setq RA 0)
 ) ;_ end of if
 (command
   "block"  "xstemp" IP       SS ""  "insert" "xstemp"
   IP      "xyz"    XS       YS ZS  RA   "explode"
   "l"      "purge"  "b"      "xstemp" "n"
  ) ;_ end of command
)

(vl-load-com)
(defun c:test()
 (if
   (setq p2 (getpoint "\nSpecify the insertion point:\n "))
    (progn       
      (setq _blkName "PONTO"
     _scaleX 1.0
     _scaleY 1.0
     _scaleZ 1.0
     _rotation 0
      ) ;_ >setq
      (setq vla-obj        (vla-insertblock
          (
           (if (eq (getvar "cvport") 1)
             vla-get-paperspace
             vla-get-modelspace
           ) ;_ >if
            (vla-get-ActiveDocument
              (vlax-get-acad-object)
            ) ;_ >vla-get-ActiveDocument
          )
          (vlax-3d-point p2)
          _blkName
          _scaleX
          _scaleY
          _scaleZ
          _rotation
        ) ;_ >vla-insertblock
      ) ;_ >setq
      (redraw (entlast) 1)
      vla-obj
    ) ;_ >progn
 ) ;_ >if  
) ;_ >defun

 (vla-insertblock
   (
    (if (eq (getvar "cvport") 1)
      vla-get-paperspace
      vla-get-modelspace
    ) ;_ >if
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     ) ;_ >vla-get-ActiveDocument
   )
   (vlax-3d-point IP)
   xstemp                                            ; is this correct? how to call a name by block?
   XS
   YS
   ZS
   RA
 )

(cond 
   ((= XS NIL)(setq XS 1))
   ((= YS NIL)(setq YS XS))
   ((= ZS NIL)(setq ZS XS))
   ((= RA NIL)(setq RA 0))
 ) 

(defun c:test ()
 ;---------------{sub function}---------------;
 
 (defun insBlock (
           _blkName                ;string
           _scaleX                ;real
           _scaleY                ;real        
           _scaleZ                ;real
           _rotation                ;real
           /
           _blkInsertPoint
           *error*
          )
   (defun *error* (errmsg)
     (princ "\nAn error has occurred in the programme.\n ")
     (prompt errmsg)
     (princ)
   ) ;_ >defun
   (setq thisdrawing
   (vla-get-activedocument
     (vlax-get-acad-object)
   ) ;_ >vla-get-activedocument
   ) ;_ >setq
   (setq mspace (vla-get-modelspace thisdrawing))
   
   (setq util (vla-get-utility thisdrawing))
   (if        (not (tblsearch "BLOCK" _blkName))
     (if
(and
  (setq filePath (findfile (strcat _blkName ".dwg")))
  (progn (command "_.-insert" filePath nil) t)          
) ;_ >and
 (setq blkFlag t)
 (setq blkFlag nil)
     ) ;_ >if
     (setq blkFlag t)
   ) ;_ >if
   (if        blkFlag
     (progn
(setq _blkInsertPoint (vla-GetPoint util nil "\nInsertion Point: "))
(setq vla-obj
       (vla-insertblock
         mspace
         _blkInsertPoint
         _blkName
         _scaleX
         _scaleY
         _scaleZ
         _rotation
       ) ;_ >vla-insertblock
) ;_ >setq        
(redraw (entlast) 1)
vla-obj
     ) ;_ >progn
     (alert "Block not found.")
   ) ;_ >if
 ) ;_ >defun
 ;---------------{sub function}---------------;
 (setq        vla-obj                ;get-vlaObject
 (insBlock        ;call sub function
   "blkName"        ;your block name
   1.0                ;scale x
   1.0                ;scale y
   1.0                ;scale z
   0.0                ;rotation
 ) ;_ >insBlock
 ) ;_ >setq
) ;_ >defun

(defun C:test ( / acDoc AcSpc MyBlockName XS YS ZS Rot insPt BlkRefObj )
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq        AcSpc 
        (vlax-get
                acDoc 
                (if (= acModelSpace (vla-get-ActiveSpace acDoc))
                        'ModelSpace
                        (if (= (vla-get-mSpace acDoc) :vlax-true)
                                'ModelSpace
                                'PaperSpace
                        )
                )
        )
)'; setq
(setq 
        MyBlockName "MyBlock"
        XS 1.0
        YS 1.0
        ZS 1.0
        Rot 0.0 ; Value in degrees
); setq
(if
        (and
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-Blocks acDoc) MyBlockName))))
                (setq insPt (getpoint (strcat "\nSpecify "" MyBlockName "" insertion point: ")))
        )
        (setq BlkRefObj (vla-InsertBlock AcSpc (vlax-3D-point insPt) MyBlockName XS YS ZS (* pi (/ Rot 180))))
)
(princ)
);| defun |; (or (vlax-get-acad-object) (vl-load-com)) (princ)