图块原位缩放

jun353835273

汉化一个英文版的图块原位缩放
注意dcl文件名为“BLKSCALE.DCL”放搜索目录或者lisp程序改下路径，源码在这里了，有点dcl基础的都可以随意diy
;***        BLKSCALE.LSP
;***        Written by Don J. Buschert
;        Southern Alberta Institute of Technology
;        1301 - 16th Ave. N.W.
;        Calgary, Alberta Canada
;        T2M 0L4
;        don.buschert@sait.ab.ca
;
;        Version 3.2        03/08/95
;        Fixed bugs in List Box.
;        Version 3.1        02/09/95
;        Added ability to select blocks by selection set
;
;        Version 3.0  10/18/94
;***
;
;        This dialog program quickly changes the scale of selected blocks,
;        using the insertion point of the block as the reference point.  The
;        scale may be an absolute or relative value to the block's existing.
;
;
;        Dialog Options
;
;        Select All...                Selects all the blocks in the list box.
;        Clear All...                Clears the selection of blocks.
;        Select Objects                Allows selection of blocks
;        Relative                Scales blocks relative to their existing scale.
;        Absolute                Scales blocks to an absolute scale
;        Scale factor                The scale factor of which the blocks will be scaled.
;
;
;
;***        Function BKSC_BLKLIST
;This function tests the block name retrieved via TBLNEXT to see if it is
;not externally dependant; then adds it to the block name list.
(defun BKSC_BLKLIST ()
  (if bksc_block_item
    (progn
      (setq bksc_block_name (cdr (assoc '2 bksc_block_item)))
      (setq bksc_block_code (cdr (assoc '70 bksc_block_item)))
      (if (and
            (if (eq (logand bksc_block_code 1) 1) nil T);if anonymous...
            (if (eq (logand bksc_block_code 16) 16) nil T);or externally dependant...
          )
        (progn ;then...
          (if (not bksc_block_list)
            ;create the block list,
            (setq bksc_block_list (list bksc_block_name))
            ;else add name to it
            (setq bksc_block_list (cons bksc_block_name bksc_block_list))            
          )
        )
      )
    )
  )
  ;sort list alphabetically
  (if bksc_block_list
    (setq bksc_block_list (acad_strlsort bksc_block_list))
  )
)
;***        Function BKSC_CHECK
;This function checks to see if the minimum data requirements have been
;inputted by the user...
(defun BKSC_CHECK ( / )
  (if (and (or (not bksc_name_list);see if blocks have been picked...
               (eq bksc_cbck "");empty callback
           )
          (not bksc_sst2);see if blocks were selected via selection
      )
    (alert
      (strcat "请选择块!")
    )
    (progn
      (done_dialog);end the dialog
      (setq bksc_doit T)
    )        
  )
)
;***        Function BKSC_GET_BLOCKS
;This function takes the callback from the list box and returns
;a list of the selected block names...
(defun BKSC_GET_BLOCKS (value)
  ;convert it to a list
  (setq bksc_blk_nlis (string_to_list value))
  ;if there were blocks picked...
  (if bksc_blk_nlis
    (progn
      ;create the name list
      (setq bksc_name_list
        (list
          (nth (nth 0 bksc_blk_nlis) bksc_block_list)
        )
      )
      ;if there is more than one block picked...
      (if (> (length bksc_blk_nlis) 1)
        (progn
          (setq bksc_coun 1);counter set to 1 to get second element
          (repeat (- (length bksc_blk_nlis) 1)
            ;retrieve name from original list
            (setq bksc_elem
              (nth (nth bksc_coun bksc_blk_nlis) bksc_block_list)
            )
            ;append to block name list
            (setq bksc_name_list (cons bksc_elem bksc_name_list))
            ;step up counter
            (setq bksc_coun (1+ bksc_coun))                     
          )
        )
      )
    )
  )
  ;pass message to "selection_msg" tile
  (if bksc_blk_nlis
    (if (> (length bksc_blk_nlis) 0)
      (set_tile "selection_msg"
        (strcat
          "已选择了： "
          (itoa (length bksc_blk_nlis))
          " 个图块"
;;;          (if (> (length bksc_blk_nlis) 1)
;;;            "选择了"
;;;            ""
;;;          )
        )
      )
    )
    (set_tile "selection_msg" "")      
  )
  ;sort the layer name list alphabetically...
  (if bksc_name_list
    (setq bksc_name_list (acad_strlsort bksc_name_list))
  )

)
;;;=================================================================**
;***        Function  BLKSCALE
;This is the main program, load dialog version...

(defun C:BLK ( /
        bksc_block_list        ;Block List for List Box
        bksc_block_code        ;Block 70 code.
        bksc_block_item        ;Block item.
        bksc_block_list        ;List of all valid blocks for dialog list box.
        bksc_block_name        ;Extracted block name.
        bksc_blk_nlis                ;Block name list from dialog callback.
        bksc_cbck                ;callback for check
        bksc_coun                ;Counter.
        bksc_doit                ;Flag which executes scaling portion of routine.
        bksc_elem                ;Element.
        bksc_elis                ;Entity data list.
        bksc_enam                ;Entity name.
        bksc_enty                ;Entity.
        bksc_indx                ;Index.
        bksc_name_list                ;String list of all the selected blocks from the
                                ;dialog list box.
        bksc_poiI                ;Insertion point of block.
        ;bksc_scale                ;New block scale.
        bksc_sst1                ;Selection set of selected blocks.
        bksc_sst2                ;Selection set containing block objects only.
        bksc_strg                ;String value from selection method.
        ;bksc_type                ;String which determines if scaling is Absolute
                                ;or Relative (GLOBAL).
        bksc_xscn                ;Current extracted block scale.
        sv_blipmode                ;"BLIPMODE".
        what_next                ;Controller for dialog display...
                )
  (graphscr)
  ;Define error routine for this command
  (defun blkscale_error (s)
    (if (/= s "Function cancelled.");if ^c occurs...
      (princ (strcat "\nError: " s))
    )
    (if olderr (setq *error* olderr))
    (if sv_blipmode (setvar "BLIPMODE" sv_blipmode))
    (princ)
  )
  (setq olderr *error*)
  (setq *error* blkscale_error)

  (setvar "CMDECHO" 0)
  (command ".UNDO" "M")
  ;turn off blipmode
  (setq sv_blipmode (getvar "BLIPMODE"))
  (setvar "BLIPMODE" 0)

  ;create a list of all the blocks in the drawing
  (setq bksc_block_item (tblnext "BLOCK" T))  
  (bksc_blklist)
  (while (setq bksc_block_item (tblnext "BLOCK"))
    (bksc_blklist)
  )
  ;set the scale type global variable...
  (if (not bksc_type)
    (setq bksc_type "Absolute")
  )
  ;initialize the dialog
  (if (findfile "BLKSCALE.DCL" );
    (if (not bksc_block_list); if there are no blocks in drawing...
      (alert "没得图块你干啥要缩放呢！")
      ;else load dialog...
      (progn
        (setq what_next 3)
        (while (< 2 what_next)
          (setq dcl_id (load_dialog "BLKSCALE.DCL"))
          ;dclfile
          ;open the dialog box
          (new_dialog "blkscale" dcl_id)
          (set_tile "block_YWSF"  "图块原位缩放 汉化by 图途")
          ;set the tile defaults...
          ;set the message tile...
          (if bksc_sst2
            (set_tile "message"
              (strcat
                (itoa (sslength bksc_sst2))
                " block(s) found..."
              )
            )
          )

          ;set the "block_list" list box
          (start_list "block_list")
          (mapcar 'add_list bksc_block_list)
          (end_list)
         
          ;set the radio button
          (if (eq bksc_type "Absolute")
            (set_tile "absolute" "1")
            (set_tile "relative" "1")
          )
        
          ;set the scale factor
          (if (not bksc_scale)
            (setq bksc_scale (getvar "DIMscale"))
          )
          (set_tile "scale" (rtos bksc_scale))
         
          ;if there was a selection of layers via Select Objects <...
          (if bksc_strg
          (progn
            (set_tile "selection_msg"
              (strcat bksc_strg
                      " Block"
                      (if (> (atoi bksc_strg) 1)
                        "s"
                        ""
                      )
                      " selected...")
            )
            
          )
        )
  
               
          ;define action for tiles
          (action_tile "block_list"
            (strcat "(setq bksc_cbck $value)" ;for check routine...
                    "(bksc_get_blocks $value)"
            )
          )
          ;if the Select All... button is pressed, run this program...
          (action_tile
            "select_all"
            (strcat
              "(select_all bksc_block_list \"block_list\")"
              "(bksc_get_blocks list_string)"
            )
          )
          ;if the Clear All... button is pressed...
          (action_tile "clear_all"
            (strcat "(set_tile \"block_list\" \"\")"
                    "(set_tile \"selection_msg\" \"\")"
            )
          )
        
          ;if the select objects button is pushed...
          (action_tile "select_entities" "(done_dialog 3)")
          ;if the absolute radio is picked...
          (action_tile "absolute" "(setq bksc_type \"Absolute\")")
          ;if the relative radio is picked...
          (action_tile "relative" "(setq bksc_type \"Relative\")")
          ;if a value is placed in the scale box...
          (action_tile "scale" "(setq bksc_scale (atof $value))")
          ;if the help button is picked...
;disabled (action_tile "help" "(saithelp \"blkscal\")")
          ;if the "do it" button is picked...
          (action_tile "help" "(saithelp)")
          (action_tile "accept" "(bksc_check)")
          ;if the "exit" button is picked...
          (action_tile "cancel" "(done_dialog)" )
          (setq what_next (start_dialog))
          (cond
            ;if Select < button was picked
            ((= what_next 3)
               (setq bksc_sst2 (ssget (list '(0 . "INSERT"))))
               (if bksc_sst2
                 (progn
                   (setq bksc_coun (sslength bksc_sst2))
                   (if bksc_sst2
                     (progn
                       ;set the string for the message
                       (setq bksc_strg (itoa bksc_coun))
                       ;clear the block name list
                       (setq bksc_name_list nil)
                     )
                   )
                 )
                 (alert "No blocks were selected...")
               )
            )
          )
          (unload_dialog dcl_id)
        );end of while
        
       );end of progn
     );end of if
   (princ "\nUnable to find BLKSCALE.dcl...")
  )
(defun saithelp()
(alert "其实操作很简单，自己测试一下。\n 感谢源码,我只是搬运工！")
(princ)
)
  rocess the Block Name list
  (if bksc_doit
    (if bksc_name_list
      (progn
        (foreach n bksc_name_list ;for each block name
          (princ (strcat "\nScanning drawing for block " (strcase n) "... "))
          (setq bksc_sst1 (ssget "X" (list (cons 2 n))));get a selection set
          (if bksc_sst1 ;if successful
            (progn
              (princ (strcat (itoa (sslength bksc_sst1)) " found, updating..."))
              (setq bksc_indx 0)
              (repeat (sslength bksc_sst1);repeat for each entity
                (setq bksc_enam (ssname bksc_sst1 bksc_indx));get ename
                (setq bksc_elis (entget bksc_enam));get entity data list
                ;determine the scale factor for the block
                (if (eq bksc_type "Absolute")
                  (setq bksc_xscn (/ bksc_scale (abs (cdr (assoc 41 bksc_elis)))))
                  (setq bksc_xscn bksc_scale)
                )
                (setq bksc_poiI (cdr (assoc 10 bksc_elis)))
                (command ".SCALE" bksc_enam "" bksc_poiI bksc_xscn)
                (setq bksc_indx (1+ bksc_indx))
              )
            )
            (alert
              (strcat "Block " (strcase n)
                      " has not been\n"
                      "inserted in the drawing!\n"
                      "Use the INSERT command to insert it first..."
              )
            )
          )   
        );end of foreach
      );end of progn
      (if bksc_sst2
        (progn
          (setq bksc_indx 0)
          (repeat (sslength bksc_sst2);repeat for each entity
            (setq bksc_enam (ssname bksc_sst2 bksc_indx));get ename
            (setq bksc_elis (entget bksc_enam));get entity data list
            ;determine the scale factor for the block
            (if (eq bksc_type "Absolute")
              (setq bksc_xscn (/ bksc_scale (abs (cdr (assoc 41 bksc_elis)))))
              (setq bksc_xscn bksc_scale)
            )
            (setq bksc_poiI (cdr (assoc 10 bksc_elis)))
            (command ".SCALE" bksc_enam "" bksc_poiI bksc_xscn)
            (setq bksc_indx (1+ bksc_indx))   
          )
        )
        (alert "No blocks were selected...")
      )
    );end of if

  );end of if
   
  (setvar "BLIPMODE" sv_blipmode)
  (setq *error* olderr)
  (princ)
)
;***        End of Progra
;***        Support functions
;***        Function (STRING_TO_LIST)
;        This function converts a string "1" or "1 2 3" into a list
;        (1) or (1 2 3).  This is useful for dialog list callbacks
;        which return strings.
;
(defun STRING_TO_LIST (strg / counter string_item string_list)
  (setq counter 1)
  (while (<= counter (strlen strg));as long as counter is less= to string
    (setq string_element "")
    (while (and ;as long as
             (<= counter (strlen strg));counter is less= to string or
             (/= (setq string_item (substr strg counter 1)) " ");grab item
           )
      (setq string_element (strcat string_element string_item))
      (setq counter (1+ counter))
    );end of while
    (if (>= (strlen string_element) 1)
      (if string_list ;append to list,
        (setq string_list (cons (atoi string_element) string_list))
        (setq string_list (list (atoi string_element)));else create list
      )
    )
    (setq counter (1+ counter))
  );end of while
  
  ;reverse the list, this returns it with the function...
  (if string_list
    (reverse string_list)
  )
)

1028882406@qq.c

谢谢楼主分享     支持一下

zhangcan0515

这个不是CAD自动的吗 我就得CAD2000上面

李钊伟2012

？？？论坛好像已经有了，很简单的代码，没有dcl

yoyoho

谢谢! jun353835273 分享程序!!!!!

gc666666

多谢。。。。。

664571221

是什么东西啊我看看

kugoo999

谢谢! jun353835273 分享程序!!!!!

Sonnenblumen

多谢。。。。。

ga619091

谢谢! jun353835273 分享程序!!!!!

baitang36

看看里面有什么

he378980280

看看 是什么东西哦

panliang9

谢谢楼主分享！