程序中LTSCALE 10想将比例修改成图框放大倍数乘以10所得的值。请大神出手修改程序
本帖最后由 635641449 于 2022-6-9 20:40 编辑(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"PLFT BLOCK")
;(alert "请选取图号属性物体:")
;(setq attname (cdr (assoc 2 (entget (car (nentsel))))))
(setq attname "DRAWINGNO")
;(alert "请选取批量输出的范围:")
(setq ss (ssget '((-4 . "<AND")(0 . "Insert")(2 . "PLFT 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 . "PLFT 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.\" \"PROCESS-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 于 2022-6-9 20:44 编辑
LTSCALE 10 将这个10替换成根据图框放大倍数乘以10得出的值（如图框比例1：50，放大倍数为50，得出的值为500），根据不同的比例替换成不同的数值 源码在这，希望有无私的大神帮帮忙优化一下
页:
[1]