;;闲来无事发一贴刷下存在感
(defun c:Vscl (/ center curitm dimscale ent entdat
etype extcode extinfoextp1 extp2 hei
i j len lst maxx maxy
minx miny msphei mspwid n1 n2
newdat newext newextinfo pickentscale
sclalecode ss vporthei wid x
y
)
(command "_.Pspace")
(setq pickent (VL-CATCH-ALL-APPLY 'entsel '("\n拾取布局视口: ")))
(if (VL-CATCH-ALL-ERROR-P pickent)
(VL-EXIT-WITH-VALUE 0)
)
(setq ent (car pickent))
(setq entdat (entget ent)
etype(cdr (assoc 0 entdat))
)
(if (/= etype "VIEWPORT")
(VL-EXIT-WITH-VALUE 0)
)
(setq lst (entget ent))
(setq wid (cdr (assoc 40 lst)) ;_布局视口宽
hei (cdr (assoc 41 lst)) ;_布局视口高
center (cdr (assoc 12 lst)) ;_视口中心点wcs
vporthei (cdr (assoc 45 lst))
scale (/ hei vporthei) ;_视口比例
mspwid (/ wid scale) ;_模型空间范围宽度
msphei (/ hei scale) ;_模型空间范围高度
x (car center)
y (cadr center)
minx (- x mspwid)
maxx (+ x mspwid)
miny (- y msphei)
maxy (+ y msphei)
extp1 (list minx miny) ;_模型空间左下角点
extp2 (list maxx maxy) ;_模型空间右上角点
)
(command "_.mspace")
;;;(command "_.zoom" "W" extp2 extp1)
(setq ss (ssget "_c"
extp2
extp1
(list (cons 0 "DIMENSION,LEADER,ARC_DIMENSION"))
)
)
(setq dimscale (/ 1.0 scale)) ;_新的标注比例
(setq i 0)
(if ss
(repeat (sslength ss)
(setq ent (ssname ss i)
i (1+ i)
)
(setq entdat (entget ent '("ACAD")))
(setq extinfo (assoc -3 entdat))
(setq sclalecode (cons 1040 dimscale))
(cond
(extinfo
(setq extcode (cadr extinfo))
(setq n1 (VL-POSITION (cons 1070 40) extcode))
(setq n2 (VL-POSITION (cons 1002 "{") extcode))
(setq j 0
newext nil
len (length extcode)
)
(cond
(n1
(repeat len
(setq curitm (nth j extcode))
(if (= j (1+ n1))
(setq newext (cons sclalecode newext))
(setq newext (cons curitm newext))
)
(setq j (1+ j))
)
)
(n2
(repeat len
(setq curitm (nth j extcode))
(if (= j (1+ n2))
(setq newext (cons sclalecode newext))
)
(setq newext (cons curitm newext))
(setq j (1+ j))
)
)
)
(setq newext (REVERSE newext))
(setq newextinfo (cons -3 (list newext)))
(setq newdat (subst newextinfo extinfo entdat))
)
(t
(setq newdat (REVERSE entdat)
newdat
(cons
(cons
-3
(list (cons "ACAD"
(list
(cons 1000 "DSTYLE")
(cons 1002 "{")
(cons 1070 40)
(cons 1040 dimscale)
(cons 1002 "}")
)
)
)
)
newdat
)
newdat (REVERSE newdat)
)
)
)
(entmod newdat)
(entupd ent)
)
)
(command "_.Pspace")
)
caiqs 发表于 2019-12-16 22:34
;;师兄 QQ361865648 Tel:13736698134于2019/12/16
;;闲来无事发一贴刷下存在感
(defun c:Vscl (/ center ...
师兄厉害，架构构思有了看来有希望弄成自己想要的了，谢谢师兄了 这个看上不难啊
页:
1
[2]