哪一行（处）可以修改标注文字大小

lff763 · 发表于 2014-11-2 15:31:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;标注所有线段(加载后只需框选所有线段便可得标注这些线段)
(defun c:ll2 ()
(COMMAND "UCS" "")
(setvar "cmdecho" 1)
(SETVAR "OSMODE" 0)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
;;选取需要测量的样条曲线、圆弧、直线、椭圆
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
(setq i 0)
;;获取系统参数textsize
(setq shh (getvar "textsize"))
(setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))
(setq hh (getdist str_hh))
(while hh
(setvar "textsize" hh)
(setq hh nil))
;;输入标注文字高度
;;循环开始
(repeat (sslength en)
(setq ss (ssname en i))
(setq endata (entget ss))
(command "lengthen" ss "")
(setq dd (getvar "perimeter"))
(princ (strcat "\n长度=" (rtos dd 2)))
;;寻找代表图层的字符串
(setq aa (assoc 0 endata))
;;获取图层名称
(setq aa1 (cdr aa))
;;判断线条种类
(cond
((= aa1 "SPLINE")
;;如果是spline
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-ControlPoints arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;循环，寻找最后一个控制点
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
((= aa1 "LWPOLYLINE")
;;如果是LWPOLYLINE
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-Coordinates arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;循环，寻找最后一个控制点
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
(t
;;如果是其他种类线条
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-StartPoint arcObj))
;;获取起点
(setq endPnt1 (vla-get-EndPoint arcObj))
;;获取终点
(setq pp1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq
pp2 (vlax-safearray->list (vlax-variant-value endPnt1))
)
)
)
)
(setq x1 (car pp1))
(setq y1 (cadr pp1))
(setq z1 (caddr pp1))
(setq x2 (car pp2))
(setq y2 (cadr pp2))
(setq z2 (caddr pp2))
(setq x (/ (+ x1 x2) 2))
(setq y (/ (+ y1 y2) 2))
(setq z (/ (+ z1 z2) 2))
(setq pt (list x y z))
;;取得线段两端的中点
(setq ang (angle pp1 pp2))
;;获取角度
(if (> (* (/ ang pi) 180) 180)
(setq ang (+ ang pi))
)
(command "text"
"j"
"bc"
pt
""
(* (/ ang pi) 180)
(strcat "" (rtos dd 2))
""
)
(setq i (1+ i))
)
(prin1)
)
(prompt "\n <>在图中直接写出长度")
(prin1)

;标注所有线段(加载后只需框选所有线段便可得标注这些线段) 
(defun c:ll2 () 
(COMMAND "UCS" "") 
(setvar "cmdecho" 1) 
(SETVAR "OSMODE" 0) 
(setq    AcadObject   (vlax-get-acad-object) 
   AcadDocument (vla-get-ActiveDocument Acadobject) 
   mSpace       (vla-get-ModelSpace Acaddocument) 
) 
;;选取需要测量的样条曲线、圆弧、直线、椭圆 
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE")))) 
(setq i 0) 
;;获取系统参数textsize 
(setq shh (getvar "textsize")) 
(setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: ")) 
(setq hh (getdist str_hh)) 
(while hh 
(setvar "textsize" hh) 
(setq hh nil)) 
;;输入标注文字高度 
;;循环开始 
(repeat (sslength en) 
  (setq ss (ssname en i)) 
  (setq endata (entget ss)) 
  (command "lengthen" ss "") 
  (setq dd (getvar "perimeter")) 
  (princ (strcat "\n长度=" (rtos dd 2))) 
  ;;寻找代表图层的字符串 
  (setq aa (assoc 0 endata)) 
  ;;获取图层名称 
  (setq aa1 (cdr aa)) 
  ;;判断线条种类 
  (cond 
    ((= aa1 "SPLINE") 
    ;;如果是spline 
    (progn 
    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) 
    (setq startPnt1 (vla-get-ControlPoints arcObj)) 
    (setq p1 
       (vlax-safearray->list (vlax-variant-value startPnt1)) 
    ) 
    (setq x1 (car p1)) 
    (setq y1 (cadr p1)) 
    (setq z1 (caddr p1)) 
    (setq pp1 (list x1 y1 z1)) 
    (repeat (- (/ (length p1) 3) 1) 
      ;;循环，寻找最后一个控制点 
      (setq p1 (cdddr p1)) 
      (setq x2 (car p1)) 
      (setq y2 (cadr p1)) 
      (setq z2 (caddr p1)) 
    ) 
    (setq pp2 (list x2 y2 z2)) 
    ) 
    ) 
    ((= aa1 "LWPOLYLINE") 
    ;;如果是LWPOLYLINE 
    (progn 
    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) 
  (setq startPnt1 (vla-get-Coordinates arcObj)) 
  (setq p1 
      (vlax-safearray->list (vlax-variant-value startPnt1)) 
  ) 
    (setq x1 (car p1)) 
    (setq y1 (cadr p1)) 
    (setq z1 (caddr p1)) 
    (setq pp1 (list x1 y1 z1)) 
    (repeat (- (/ (length p1) 3) 1) 
      ;;循环，寻找最后一个控制点 
      (setq p1 (cdddr p1)) 
      (setq x2 (car p1)) 
      (setq y2 (cadr p1)) 
      (setq z2 (caddr p1)) 
    ) 
    (setq pp2 (list x2 y2 z2)) 
    ) 
    ) 
    (t 
    ;;如果是其他种类线条 
    (progn 
    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) 
    (setq startPnt1 (vla-get-StartPoint arcObj)) 
    ;;获取起点 
    (setq endPnt1 (vla-get-EndPoint arcObj)) 
    ;;获取终点 
    (setq pp1 
       (vlax-safearray->list (vlax-variant-value startPnt1)) 
    ) 
    (setq 
      pp2 (vlax-safearray->list (vlax-variant-value endPnt1)) 
    ) 
    ) 
    ) 
  ) 
  (setq x1 (car pp1)) 
  (setq y1 (cadr pp1)) 
  (setq z1 (caddr pp1)) 
  (setq x2 (car pp2)) 
  (setq y2 (cadr pp2)) 
  (setq z2 (caddr pp2)) 
  (setq x (/ (+ x1 x2) 2)) 
  (setq y (/ (+ y1 y2) 2)) 
  (setq z (/ (+ z1 z2) 2)) 
  (setq pt (list x y z)) 
  ;;取得线段两端的中点 
  (setq ang (angle pp1 pp2)) 
  ;;获取角度 
  (if    (> (* (/ ang pi) 180) 180) 
    (setq ang (+ ang pi)) 
  ) 
  (command "text" 
      "j" 
      "bc" 
      pt 
      "" 
      (* (/ ang pi) 180) 
      (strcat "" (rtos dd 2)) 
      "" 
  ) 
  (setq i (1+ i)) 
) 
(prin1) 
) 
(prompt "\n <>在图中直接写出长度") 
(prin1)

lff763 · 发表于 2014-11-2 15:33:16

标注的文字大了，希望可以设置小些

zxq0220 · 发表于 2014-11-2 17:35:49

本帖最后由 zxq0220 于 2014-11-3 20:42 编辑

  (command "text"
   "j"
   "bc"
   pt
   ""
   (* (/ ang pi) 180)
   (strcat "" (rtos dd 2))
   ""
  )
改成
  (command "text" "bc" pt shh (* (/ ang pi) 180) (rtos dd 2))

iLisp · 发表于 2014-11-2 19:52:45

这样求长度不是lisper方向呦

st788796 · 发表于 2014-11-2 20:31:24

进阶第一步，基本结构

;;标注所有线段(加载后只需框选所有线段便可得标注这些线段)
(defun c:ll2 (/ tf ss hh hhAcadObject
AcadDocument mSpace sl epam len
mpam lst e
)
(vl-load-com)
(if (zerop (getvar "worlducs"))
(progn
(command ".ucs" "w" "")
(setq tf t)
)
)
(if (and (setq ss (ssget (list '(0 . "*line,arc,ellipse"))))
(if (not (setq hh (getdist (strcat "\n文字高度 <"
(rtos (getvar "textsize") 2)
">: "
)
)
)
)
(setq hh (getvar "textsize"))
hh
)
)
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(setq epam (vlax-curve-getendparam e) ;_结束参数
len (vlax-curve-getdistatparam e epam) ;_总长度
mpam (vlax-curve-getparamatdist e (* 0.5 len)) ;_一半距离参数
lst (cons
(list len ;_总长度
(vlax-curve-getpointatparam e mpam) ;_中间点
(angle '(0. 0.) (vlax-curve-getfirstderiv e mpam)) ;_切线方向
)
lst
)
)
) ;_先构造一个表
(setvar "cmdecho" 0)
(foreach x lst
(command "text"
"j"
"bc"
"_none"
(cadr x)
hh
(* (/ (last x) pi) 180)
(rtos (car x) 2)
""
)
)
)
)
(if tf
(command ".ucs" "p")
)
(princ)
)

;;标注所有线段(加载后只需框选所有线段便可得标注这些线段) 
(defun c:ll2 (/               tf        ss         hh          hhAcadObject 
              AcadDocument        mSpace         sl          epam           len 
              mpam     lst        e 
             ) 
  (vl-load-com) 
  (if (zerop (getvar "worlducs")) 
    (progn 
      (command ".ucs" "w" "") 
      (setq tf t) 
    ) 
  ) 
  (if (and (setq ss (ssget (list '(0 . "*line,arc,ellipse")))) 
           (if (not (setq hh (getdist (strcat "\n文字高度 <" 
                                              (rtos (getvar "textsize") 2) 
                                              ">: " 
                                      ) 
                             ) 
                    ) 
               ) 
             (setq hh (getvar "textsize")) 
             hh 
           ) 
      ) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (setq epam (vlax-curve-getendparam e) ;_结束参数 
              len  (vlax-curve-getdistatparam e epam) ;_总长度 
              mpam (vlax-curve-getparamatdist e (* 0.5 len)) ;_一半距离参数 
              lst  (cons 
                     (list len ;_总长度 
                           (vlax-curve-getpointatparam e mpam) ;_中间点 
                           (angle '(0. 0.) (vlax-curve-getfirstderiv e mpam)) ;_切线方向 
                     ) 
                     lst 
                   ) 
        ) 
      ) ;_先构造一个表 
      (setvar "cmdecho" 0) 
      (foreach x lst 
        (command "text" 
                 "j" 
                 "bc" 
                 "_none" 
                 (cadr x) 
                 hh 
                 (* (/ (last x) pi) 180) 
                 (rtos (car x) 2) 
                 "" 
        ) 
      ) 
    ) 
  ) 
  (if tf 
    (command ".ucs" "p") 
  ) 
  (princ) 
)

lff763 · 发表于 2014-11-3 15:25:59

第39行，“先构造一个表 ” ，是指把标注的数据汇总到表格吗？

账号		自动登录	找回密码
密码			立即注册

[求助] 哪一行（处）可以修改标注文字大小

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评