程序中LTSCALE 10想将比例修改成图框放大倍数乘以10所得的值。请大神出手修改程序

635641449

(defun c:PFTK (/ dwgpath tkname         attname ss         num         sslen
                 ent1         p1         p2         attobj         attlen         attnum
                 att         tagstr         ssf         osm PATH
                )


  (vl-load-com)
(command "undo" "be")
;;(command "audit" "y")
(alert "批量分图0.3 请注意: 1. 不同图框里的图号不能重名  2. 当前图纸目录下不能有与待分图名称相同的CAD文件,如有请删除!!!")
(setq osm (getvar "osmode"))
  (setq lts (getvar "LTSCALE"))
  (Setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (Setvar "LTSCALE" 10)
  (command "ucs" "w")
(setvar "filedia" 0)
(setq dwgpath (getvar "dwgprefix"))
;(alert "请选取图框:")
;(setq tkname (cdr (assoc 2 (entget (car (entsel))))))
(setq tkname  "LFT BLOCK")
;(alert "请选取图号属性物体:")
;(setq attname (cdr (assoc 2 (entget (car (nentsel))))))
(setq attname "DRAWINGNO")
;(alert "请选取批量输出的范围:")

(setq ss (ssget '((-4 . "<AND")(0 . "Insert")(2 . "LFT BLOCK")(-4 . "AND>"))))
(setq num 0)
(setq sslen (sslength ss))

(while (< num sslen)
        (setq ent1 (vlax-ename->vla-object (ssname ss num)))
        (if (= (vlax-get ent1 'Name) tkname)
                (progn
                        (vla-getboundingbox ent1 'p1 'p2)
                        (setq p1 (vlax-safearray->list p1))
                        (setq p2 (vlax-safearray->list p2))

                        (setq attobj (vlax-safearray->list (vlax-variant-value (VLA-GETATTRIBUTES ent1))))
                        (setq attlen (length attobj))
                        (setq attnum 0)
                        (while (< attnum attlen)
                                (setq att (nth attnum attobj))
                                (setq tagstr (vlax-get att 'TagString))
                                (if (= tagstr attname)
                                        (progn
                                        (setq dwgname (vlax-get att 'TextString))
                                        (setq attnum attlen)
                                        )
                                )
                                (setq attnum (1+ attnum))
                        )

                        (setq dwgname (strcat dwgpath dwgname))
                        
                        (command "zoom" "e")
                        (command "limits" "0,0" (list (- (nth 0 p2) (nth 0 p1)) (- (nth 1 p2) (nth 1 p1))))
                        
                        (setq ssf (ssget "C" p1 p2))
                        (command "move" ssf "" p1 "0,0,0")
                        (command "zoom" (getvar "limmin") (getvar "limmax"))

                        (command "_wblock" dwgname "" "0,0" ssf "")
                        (command "oops")
                        (command "move" ssf "" "0,0" p1)
                )
        )
        (setq num (1+ num))
)
(setvar "filedia" 1)
(command "undo" "end")
  (setvar "osmode" osm)
  (Setvar "LTSCALE" lts)
  (setq commands "ggkj" PATH "C:/cadtools/Automatic.scr")
;(alert "分图完成!!!")
; (load "automatic.fas")
  (init-1)
( PROCESS-1)

)


;更改空间
(defun c:ggkj (/ ss1 ent1 tb tbs p1 p2 p2a p3 p2x p2y)

;更改空间的图块
(setq ss1 (ssget "x" '((0 . "Insert")(-4 . "<or")(2 . "A213-Title_Block")(-4 . "or>"))))

(setq tb (ssget "x" '((-4 . "<AND")(0 . "Insert")(2 . "LFT BLOCK")(-4 . "AND>"))))
(setq tbs (cdr (assoc 41 (entget (ssname TB 0)))))
(setq ent1 (vlax-ename->vla-object (ssname TB 0)))
(vla-getboundingbox ent1 'p1 'p2)
(setq p1 (vlax-safearray->list p1))
(setq p2 (vlax-safearray->list p2))
(setq p2x(/(car P2)TBS))
(setq p2Y(/(cadr P2)TBS))
(setq p2a(list p2x p2y 0))
(setq p3(list (- 0 p2Y) 0 0))
(setvar "TILEMODE" 0)
(command "mview"  "0,0" p2a ".MSPACE" "zoom" "w" "0,0" p2 )
(command ".chspace" ss1 "")
(VL-CMDF "MVIEW" "L" "on" "all" "")
(if (< p2x p2y)
  (command "rotate" "all" "" p1 90 "move" "all" "" p3 p1)
)
)





(defun SDIR-1 (/ dwgname dwgname1)
  (setq num 0)
  (setq sslen (sslength ss))
  (while (< num sslen)
    (setq ent1 (vlax-ename->vla-object (ssname ss num)))
    (if        (= (vlax-get ent1 'Name) tkname)
      (progn

        (setq attobj (vlax-safearray->list
                       (vlax-variant-value (VLA-GETATTRIBUTES ent1))
                     )
        )
        (setq attlen (length attobj))
        (setq attnum 0)
        (while (< attnum attlen)
          (setq att (nth attnum attobj))
          (setq tagstr (vlax-get att 'TagString))
          (if (= tagstr attname)
            (progn
              (setq dwgname (STRCAT (vlax-get att 'TextString) ".DWG"))
              (setq attnum attlen)
            )
          )
          (setq attnum (1+ attnum))
        )

      )
    )

    (setq num (1+ num))

    (if        (= dwgname1 "")
      (progn
        (SETQ dwgname (list dwgname))
        (setq dwgname1 dwgname)
      )
      (setq dwgname1 (cons dwgname dwgname1))
    )
  )

  (SETQ X (cons dwgpath dwgname1))
)

(setq dwgpath nil
      F        nil
      FL nil
      F1 nil
      X        nil
      scrfile nil)

   ;init-1ialize
(defun init-1  ()
  (SDIR-1)
  (setq dwgpath (car X))
  (setq X (acad_strlsort (cdr X)))
  (setq        n2 (rtos (length X) 2 0)
        n1 "1")
  (if (= n2 1)
    (setq dwgs "Drawing")
    (setq dwgs "Drawings"))
  )
(defun PROCESS-1 (/ SCRFILE DMSG)
  (setq SCRFILE (open PATH "W"))
  ;(setq SCRFILE (open "Automatic1.scr" "W"))
  (write-line
    (strcat
      "(dos_getprogress
      \"Automatic             "
      N2
      " "
      DWGS
      " selected total \"
      \"The Selected files is being progress, Please wait...\" "
      N2
      ")"
     )
    SCRFILE
  )
  (write-line "(setvar \"cmddia\" 0)" SCRFILE)
  (foreach DWGFILE X
    ;(write-line "(load \"Automatic.lsp\")" SCRFILE)
    ;(write-line (strcat "(AP_OPENP \" DWGPATH DWGFILE " \ ")") SCRFILE)
    (if        (= CHKSDI 1)
      (write-line (strcat "open y \"" DWGPATH DWGFILE "\"") SCRFILE)
      (write-line (strcat "open \"" DWGPATH DWGFILE "\"") SCRFILE)
    )
    ;(write-line "DGNPURGE PU ZOOM E" SCRFILE)
    (write-line commands SCRFILE)

    (write-line "(dos_getprogress -1)" SCRFILE)
    (if        (= N1 N2)
      (progn (write-line "(dos_getprogress t)" SCRFILE)
             (write-line
               (strcat "(dos_msgbox \""
                       N2
                       " Drawing(s) has been PROCESS-1.\" \"ROCESS-1\" 1 3 5)"
               )
               SCRFILE
             )
      )
    )
    (setq N1 (rtos (+ 1 (atoi N1)) 2 0))
    (write-line ".CLOSE n" SCRFILE)
  )
  (write-line "(setvar \"cmddia\" 1)" SCRFILE)
  (close SCRFILE)
  (command "script" PATH)
)



(princ)






这段程序在办公室的电脑里运行没有任何问题，拿回来家里面运行就出问题了，不能在布局里建立视口，更不能将图框块写入布局里了。看得懂这段程序的大神能帮忙优化一下吗？程序很不稳定，希望lisp专家能帮忙优化。万分感谢

635641449

LTSCALE 10    将这个10替换成根据图框放大倍数乘以10得出的值（如图框比例1：50，放大倍数为50，得出的值为500），根据不同的比例替换成不同的数值

635641449

源码在这，希望有无私的大神帮帮忙优化一下