插入图框时，自动调整标注比例，以适应打印纸张

lengxiaxi

以下源码是 开心 做的一个外挂，可以加入一些自定义的图块。我的想法是把这个功能用于插入图框。预先定义好图框后，根据不同大小的图纸（都是1:1的），自动调取图框。如何修改这个lsp，可以实现如下功能：

1，插入图块时，可以根据物体大小，自动缩放图框图块的大小，以完全覆盖物体。
2，不同物体大小，缩放图框后，标注比例随之缩放。以实现打印任意大小的物体到A4纸都是统一的标注大小。

AMTONNY

;;;;;;;;;;;;;;;;;;***********************
;;;;;;;;;;;;;;;;;;***********************
;;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(polar  p2 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))
)
)

bai2000

楼上的，没反应啊？？？

00放飞梦想00

AMTONNY 发表于 2014-11-28 22:27
;;;;;;;;;;;;;;;;;;***********************
;;;;;;;;;;;;;;;;;;***********************
;;amtonny 2011 ...

目前是用不了的，方便时改改

shcvip

程序出错，(sslength ZAMTEXT)

LPACMQ

增强标注-不同图框自动更改全局比例
http://bbs.mjtd.com/forum.php?mo ... amp;fromuid=7304201
(出处: 明经CAD社区)