[分享]：朋友做的局部放大缩小程序

xopo

朋友做的局部放大缩小程序，本人感觉很好用，特和大家分享，就是不知道他有没有在论坛上发表过，见过的朋友笑笑而过，喜欢的朋友就顶一下。

halibt

不错，帮你顶一下。如果能支持矩形选择的话，做个局部剪裁工具可能通用性更强了

zh_6531394

不行,为什么不能对尺寸线进行操作

xopo

因为是在同一个绘图空间，放大缩小后尺寸也已经改变，如果你想保留原来的尺寸数据，还是建议你在图纸空间开视口。

chenwei_zj

试用了一下，只一个功能很弱的功能，失望中。。。

hmh888888

江民截住说有恶意脚本，请说明原因

xopo

是江民误报，金山，瑞星，铁赛门都通过了，你的江民不是盗版的吧！？汗。。。。。
这是一个搞机械的朋友编的，可能只适合我们搞机械的吧，对其他专业也许没有多大的用处，就像论坛上的很多程序对我们也没有用。
呵呵。。。。。。。大家见谅见谅！！

51768

最初由 xopo 发布
[B]是江民误报，金山，瑞星，铁赛门都通过了，你的江民不是盗版的吧！？汗。。。。。
这是一个搞机械的朋友编的，可能只适合我们搞机械的吧，对其他专业也许没有多大的用处，就像论坛上的很多程序对我们也没有用。
呵... [/B]

其它专业也是可以用的，只是针对性不强，这是专业限制很正常啊

xjlmlxbq

能否上传源码,让大家学习一下?

c7242865

源码
(defun c:JBFD (/  set1 set2 set3 set4 cpoint r p k n ep ss pt1 pt2 pt3 pt4 dh smw1 me me1 xb yb pp pn kk me2 me3 smw2 me4 me5 x1 y1)
(prompt "\n请指定放大区域:\n")
(setq set1 (getvar "osmode"))  
(setq set2 (getvar "orthomode"))  
(SETQ SET3 (GETVAR "BLIPMODE"))  
(SETQ SET4 (GETVAR "CMDECHO"))  
(SETVAR "BLIPMODE" 0)  
(setvar "osmode" 0)  
(setvar "orthomode" 0)  
(SETVAR "CMDECHO" 0)
(command "circle" pause pause)
(setq cpoint (cdr (assoc 10 (entget (entlast)))))
(setq r (cdr (assoc 40 (entget (entlast)))))
(setq pt1 (polar cpoint (/ pi 2) (+ 0.01 r)))
(setq pt2 (polar pt1 (* pi 0.75) 10))
(setq pt3 (polar pt2 pi 8))
(setq pt4 (polar pt3 (* pi 0.25) 2))
(command "line" pt1 pt2 pt3 "")
(setq dh (getstring "\n 请输入局部代号:"))
(command "text" pt4 "4" "0" dh)
(setq p (getpoint"\n 请指定放大图放置位置:"))
(setq k (getreal"\n 请指定放大倍数:"))
(command "copy" "cp")
(setq n 0)(repeat 180  (command (polar cpoint (/(* 2 n pi)180) r))
(setq n (1+ n)))(command "" "" cpoint p)
(setq n 0)(setvar "PICKBOX" 5)(command "ZOOM" "C" P (* 3 r))(command "circle" p r)(setq ep (entlast))(command "TRIM" EP "")(repeat 180(command (polar p (/(* 2 n pi)180)(* r 1.1)))(command "f" (polar p (/(* 2 n pi)180)(* r 1.1)))(setq n (+ n 1))(command (polar p (/(* 2 n pi)180)(* r 1.01)) ""))(command "")(command "zoom" "p") (setq ss (ssget "c" (list (- (car p) r)(- (cadr p) r))                     (list (+ (car p) r)(+ (cadr p) r)) )        )(command "scale" ss "" p k)(command "erase" ep "")(setq smw1 (list 0 0 0))(setq smw2 (polar smw1 0 24));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(command "text" smw1 "4" "0" (strcat dh "部放大" ))
(setq me (entlast))
(setq me1 (entget me))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "line" smw1 smw2 "")
(setq me2 (entlast))
(setq me3 (entget me2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "text" smw1 "4" "0" (strcat  (rtos k) ":1" ))
(setq me4 (entlast))
(setq me5 (entget me4))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq pn T)(princ"\n 请确定说明文字位置:")
(while pn(setq pp (grread t))
(setq kk (car pp))
(setq pp (cadr pp))
(setq xb (nth 0 pp))
(setq yb (nth 1 pp))
(setq x1 (- xb 36))
(setq y1 (+ yb 12))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq me1 (subst (list 10 x1 y1)(assoc 10 me1) me1))(entmod me1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq me3 (subst (list 10 (- x1 4) (- y1 2))(assoc 10 me3) me3))
(setq me3 (subst (list 11 (+ x1 20) (- y1 2))(assoc 11 me3) me3))(entmod me3)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq me5 (subst (list 10 (+ x1 4) (- y1 8))(assoc 10 me5) me5))(entmod me5)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= kk 3)(setq pn nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
(command "redraw")
(setvar "osmode" set1)
(setvar "orthomode" set2)
(setvar "blipmode" set3)
(setvar "cmdecho" set4)
(PRINC)
)

xopo

非常期待安根兄把尺寸修改程序也发表出来，让更多朋友可以分享。

Michael_66

好像现在的局部放大程序，放大后尺寸都要改变

xjlmlxbq

谢谢,真的不错,收下了

allan439

感觉不太有用~~~~~~~~

jx2008

对于标注尺寸不起作用