xaove 发表于 2007-1-29 03:32:00

[求助]直线上的文字自动居中,并且与直线有指定的间隔

本帖最后由 作者 于 2007-1-29 3:32:34 编辑 <br /><br /> <p>大虾们,如题,帮帮忙!</p><p>用到的地方,比如梁的编号与梁线</p>

mccad 发表于 2007-1-29 08:17:00

用标注，改标注样式，不用箭头、不用界线、不用标注线，就OK了。不用编程

lifefun 发表于 2012-11-7 17:01:26

我也需要这个功能的代码

编程小白 发表于 2013-1-14 17:01:02

“mccad”的方法问题是怎样有与直线固定的间隙呢

阿然 发表于 2013-1-14 22:50:57

写了一个，感觉不完善
用了grread，距离就不知道怎么用键盘输入
期待高人完善

(vl-load-com)
(setvar "cmdecho" 0)
(setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))

(defun c:tt (/ ent stpt enpt midpt lineang txt grpt pt templine)
(if (not *txth*)
    (setq *txth* (cond ((getreal "\n输入标注文字高度:"))
         (2.0)
   )
    )
)
(if (and (setq ent (car (entsel "\n选择直线:")))
   (setq elst (entget ent))
   (equal (cdr (assoc 0 elst)) "LINE")
      )
    (progn
      (if (setq txt (getstring "\n输入标注文字:"))
(progn
    (setqstpt(cdr (assoc 10 elst))
    enpt(cdr (assoc 11 elst))
    midpt(mapcar '(lambda (x y) (/ (+ x y) 2.)) stpt enpt)
    lineang(angle stpt enpt)
    )
    (setq grpt (cadr (grread 5)))
    (setq
      grdist (distance (vlax-curve-getclosestpointto ent grpt)
         grpt
       )
    )
    (if (LM:Clockwise-p stpt enpt grpt)
      (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)
      txtang (+ lineang pi)
      )
      (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)
      txtang lineang
      )
    )
    (setq txtobj (Xr:drawtext txt temppt *txth*))
    (vla-put-rotation txtobj txtang)
    (prompt "\n选择方向和距离:")
    (while (and (setq gr (grread 5))
          (= (car gr) 5)
   )
      (setq grpt (cadr gr))
      (setq
      grdist (distance (vlax-curve-getclosestpointto ent grpt)
             grpt
         )
      )
      (if(LM:Clockwise-p stpt enpt grpt)
      (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)
      txtang (+ lineang pi)
      )
      (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)
      txtang lineang
      )
      )
      (vlax-put-property
      txtobj
      'TextAlignmentPoint
      (vlax-3d-point temppt)
      )
      (vla-put-rotation txtobj txtang)
      (redraw)
    ) ;_while
)
      )
    )
    (progn
      (princ "\n选择的不是直线或者取消选择")
      (princ)
    )
)
)

(defun LM:Clockwise-p (p1 p2 p3)
((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))
    (mapcar '- p1 p3)
)
)


;;;绘制文字
(defun Xr:Drawtext (txtstring txtpt txtheight / otext textpt)
(setq textpt (vlax-3d-point txtpt))
(setq
    otext (vla-addtext *MoSpace* txtstring textpt txtheight)
)
(vlax-put-property otext 'Alignment 10)
(vlax-put-property otext 'TextAlignmentPoint textpt)
otext
)






页: [1]
查看完整版本: [求助]直线上的文字自动居中,并且与直线有指定的间隔