插入图框时，自动调整标注比例，以适应打印纸张
以下源码是 开心 做的一个外挂，可以加入一些自定义的图块。我的想法是把这个功能用于插入图框。预先定义好图框后，根据不同大小的图纸（都是1:1的），自动调取图框。如何修改这个lsp，可以实现如下功能：1，插入图块时，可以根据物体大小，自动缩放图框图块的大小，以完全覆盖物体。
2，不同物体大小，缩放图框后，标注比例随之缩放。以实现打印任意大小的物体到A4纸都是统一的标注大小。 ;;;;;;;;;;;;;;;;;;***********************
;;;;;;;;;;;;;;;;;;***********************
;;amtonny 2011/5/15
;;自动调整打印文字高度
(defun c:ZZ(/ di ds en po1 po2 obj endxf fx a1 a2 ys)
(vl-load-com)
(prompt "\n自动调整打印文字高度.......")
(setq os(getvar 'osmode) cmd(getvar 'cmdecho))
(setq oer *error* *error* my)
;;;;;;;;;;;;;;;
(setvar "cmdecho" 0)
(SETQ VIEWCTR (GETVAR "VIEWCTR"))
(SETQ VIEWSIZE (GETVAR "VIEWSIZE"))
(SETQ CORNER1 (LIST (+ (/ VIEWSIZE 1.2) (CAR VIEWCTR) )(+ (/ VIEWSIZE 2) (CADR VIEWCTR)) ))
(SETQ CORNER2 (LIST (- (CAR VIEWCTR) (/ VIEWSIZE 1.2)) (- (CADR VIEWCTR) (/ VIEWSIZE 2) )))
;;;;;;;;;;;;;;;
(setq SS (ssget "C" CORNER1 CORNER2 '((0 . "LWPOLYLINE"))))
(IF (= ss nil)
(progn (ALERT "错误提示\n當前窗口沒有你要打印的圖框, 請把需打印的圖框边画上多段线......\n本訊息由系統自動提示.") (exit)
))
(setvar "nomutt" 0)
(setq sslen(sslength ss) i 0)
(vl-cmdf "UNDO" "G")
(repeat sslen
(setq en(ssname ss i))
(setq obj (vlax-ename->vla-object EN))
(setq endxf(dxf 0 en))
(cond ((or (= endxf "CIRCLE") (= endxf "ELLIPSE") (= endxf "LINE") (= endxf "ARC") (= endxf "SPLINE"))
;((/ endxf "LWPOLYLINE")
)
((= endxf "LWPOLYLINE")
(setq plist '())
(mapcar '(lambda (x) (if (= (car x) 10) (setq plist(cons (cdr x) plist))))(entget en))
(setq DSAS(nth 0 plist) p2(nth 1 plist) DSASS(nth 2 plist) p4(nth 3 plist))
(setq a1(+ (angle p2 DSAS) 3) a2(+ (angle p2 DSASS) 3))
(setq po1(polarp2 a1 3) po2(polar p2 a2 3))
(grdraw DSAS DSASS 1 5)
(grdraw p2 p4 1 5)
(grdraw DSAS p2 1 5)
(grdraw p2 DSASS 1 5)
(grdraw DSASS p4 1 5)
(grdraw DSAS p4 1 5)
;;;;;;;;;;;;;;;;;;;;;;
(SSTT)
))
(setq i(1+ i))
)
(prompt "\n调整打印文字高度已完成.......")
(vl-cmdf "UNDO" "E")
(setvar 'osmode os)
(setvar 'cmdecho cmd)
(princ)
)
(defun EAA(x) ;求面积
(setq ena(vlax-curve-getArea x))
)
;;;
(defun dxf(n en)
(cdr(assoc n (entget en)))
)
;;;
(defun my(s)
(if (/= s "Function canccelled")
(princ"取消"))
(setvar 'osmode os)(setvar 'cmdecho cmd)(setvar "nomutt" 0)
(setq *error* oer)
)
(defun SSTT(/ ssdim)
(setvar "cmdecho" 0)
(setq dimsc(getvar "dimscale"))
(setvar "osmode" 33)
(setvar "DIMZIN" 8)
;(setq DSAS (getpoint "\n --->>>请框选图框对角点:"))
;(setq DSASS (getcorner DSAS))
(setvar "osmode" 0)
(setq DALA (distance DSAS DSASS))
(setq ZASD (rtos (/ DALA 300) 2 2))
(setq ssdim (ssget "C" DSAS DSASS'((0 . "DIMENSION"))))
(if (not ssdim) (exit))
(ZATEXT)
(command "_dimoverride" "dimscale" zasd "" ssdim "")
(command "_dimoverride" "dimtxt" 3 "" ssdim "")
(setvar "dimscale" dimsc)
;;(prompt (STRCAT "\n已将本页标注全局比例调整为: "zasd """文字高度调整为: " (rtos hig 2 2)))
(setvar "DIMZIN" 2)
(setvar "osmode" 183)
(princ)
)
(DEFUN ZATEXT()
(setq ZAMTEXT (ssget "C" DSAS DSASS'((-4 . "<or") (0 . "mtext") (0 . "text") (-4 . "or>"))))
(setq hig (* 2.5 (atof ZASD)))
(setq h40 (cons 40 hig))
(setq n (sslength ZAMTEXT))
(setq k 0 )
(while (< k n)
(setq name (ssname ZAMTEXT k))
(setq a (entget name))
(setq b (assoc '0 a))
(setq b (cdr b))
(setq h (assoc '40 a))
(setq a (subst h40 h a))
(entmod a)
(setq k (+ k 1))
)
)
楼上的，没反应啊？？？ AMTONNY 发表于 2014-11-28 22:27
;;;;;;;;;;;;;;;;;;***********************
;;;;;;;;;;;;;;;;;;***********************
;;amtonny 2011 ...
目前是用不了的，方便时改改 程序出错，(sslength ZAMTEXT) 增强标注-不同图框自动更改全局比例
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100053&fromuid=7304201
(出处: 明经CAD社区)
页:
[1]