绘制动态文本和线条。
大家好以下代码用于绘制动态文字和线条。
如图所示。
http://www.ikaca.sh.cn/attachment/201010/23/1745_1287803822VAzw.png
但错误总是发生。调试之后。
我发现这些代码中存在代码。
(setq text (vla-addtext mSpace fh (vlax-3d-point nextPt)))
整个计划。感谢您抽出时间阅读本文。
(defun c:tt(/)
(vl-load-com)
(defun *error* (msg)
(setvar "osmod" osmode_old)
)
(defun text_length (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4)
(setq textent (entget (vlax-vla-object->ename Text)))
(setq p0(cdr (assoc 10 textent))
ang(cdr (assoc 50 textent))
sinrot (sin ang)
cosrot (cos ang)
t1(car (textbox textent))
t2(cadr (textbox textent))
p1(list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
(+ (cadr p0)
(+ (* (car t1) sinrot) (* (cadr t1) cosrot))
)
)
p2(list
(+ (car p0)
(- (* (car t2) cosrot) (* (cadr t1) sinrot))
)
(+ (cadr p0)
(+ (* (car t2) sinrot) (* (cadr t1) cosrot))
)
)
)
(distance p1 p2)
)
(setq mSpace (vla-get-ModelSpace(vla-get-ActiveDocument (vlax-get-acad-object))))
(setq entbak (ssadd))
(setq osmode_old (getvar "osmode"))
(setvar "osmode" 0)
(setq pt (getpoint "\nget the center point."))
(command "_.circle" pt)
(princ (strcat "\ninput the radius of circle"))
(command pause)
(setq cir (vlax-ename->vla-object (entlast)))
(ssadd (entlast) entbak)
;start to input the makr.
(setq hasMore T)
(while hasMore
(setq nextPt (grread T 4 0)
readtype (car nextPt)
readvale (cadr nextPt)
)
(cond ((= readtype 5)
(setq nextPt (cadr nextPt))
(setq nextPt (trans nextPt 1 0))
(setq basePt (vlax-curve-getclosestpointto cir nextPt))
(if (not line)
(progn
(if (not fh)
(setq fh "A")
)
(setq text (vla-addtext mSpace fh (vlax-3d-point nextPt)))
(ssadd (entlast) entbak)
(setq txtlen (text_length text))
(setq l2end (vla-addline mSpace (vlax-3d-point nextPt) (vlax-3d-point l2end)))
)
(progn
(vla-put-startpoint line (vlax-3d-point basePt))
(vla-put-endpoint line (vlax-3d-point nextPt))
(vla-update line)
(setq ptt (car nextPt))
(if (> ptt pt)
(progn
(setq textleft (+ (car nextPt) (getvar "dimgap")))
(setq l2left (+ (car nextPt) txtlen (getvar "dimgap")))
)
(progn
(setq textleft (- (car nextPt) (getvar "dimgap") txtlen))
(setq l2left textleft)
)
)
(vla-put-insertionpoint text (vlax-3d-point list textleft (+ (cadr nextPt) (getvar "dimgap")) 0))
(vla-update text)
(vla-put-startpoint l2 (vlax-3d-point nextPt))
(setq l2end (list l2left (cadr nextPt) 0))
(vla-put-endpoint l2 (vlax-3d-point l2end))
(vla-update l2)
)
)
)
((= readtype 3)
(setq i nil)
)
((or (= 25 readtype) (= 13 readtype))
;(
)
)
)
) 找出原因。应该是：
(setq text (vla-addtext mSpace fh (vlax-3d-point nextPt) (getvar "dimtxt")))
更新的代码：
(defun c:tt(/ line fh text)
(vl-load-com)
(defun *error* (msg)
(setvar "osmod" osmode_old)
)
(defun text_length (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4)
(setq textent (entget (vlax-vla-object->ename Text)))
(setq p0(cdr (assoc 10 textent))
ang(cdr (assoc 50 textent))
sinrot (sin ang)
cosrot (cos ang)
t1(car (textbox textent))
t2(cadr (textbox textent))
p1(list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
(+ (cadr p0)
(+ (* (car t1) sinrot) (* (cadr t1) cosrot))
)
)
p2(list
(+ (car p0)
(- (* (car t2) cosrot) (* (cadr t1) sinrot))
)
(+ (cadr p0)
(+ (* (car t2) sinrot) (* (cadr t1) cosrot))
)
)
)
(distance p1 p2)
)
(setq mSpace (vla-get-ModelSpace(vla-get-ActiveDocument (vlax-get-acad-object))))
(setq entbak (ssadd))
(setq osmode_old (getvar "osmode"))
(setvar "osmode" 0)
(setq pt (getpoint "\nget the center point."))
(command "_.circle" pt)
(princ (strcat "\ninput the radius of circle"))
(command pause)
(setq cir (vlax-ename->vla-object (entlast)))
(ssadd (entlast) entbak)
;start to input the makr.
(setq hasMore T)
(while hasMore
(setq nextPt (grread T 4 0)
readtype (car nextPt)
readvale (cadr nextPt)
)
(cond ((= readtype 5)
(setq nextPt (cadr nextPt))
(setq nextPt (trans nextPt 1 0))
(setq basePt (vlax-curve-getclosestpointto cir nextPt))
(if (not line)
(progn
(if (not fh)
(setq fh "A")
)
(setq text (vla-addtext mSpace fh (vlax-3d-point nextPt) (getvar "dimtxt")))
(ssadd (entlast) entbak)
;(setq txtlen (text_length text))
(setq line (vla-addline mSpace (vlax-3d-point basePt) (vlax-3d-point nextPt)))
(ssadd (entlast) entbak)
(setq txtlen (text_length text))
(setq l2end (list (+ (car nextPt) txtlen) (cadr nextPt) 0))
(setq l2 (vla-addline mspace (vlax-3d-point nextPt) (vlax-3d-point l2end)))
(ssadd (entlast) entbak)
)
(progn
(vla-put-startpoint line (vlax-3d-point basePt))
(vla-put-endpoint line (vlax-3d-point nextPt))
(vla-update line)
(setq ptt (car nextPt))
(setq ptx (car pt))
(if (> ptt ptx)
(progn
(setq textleft (+ (car nextPt) (getvar "dimgap")))
(setq l2left (+ (car nextPt) txtlen (getvar "dimgap")))
)
(progn
(setq textleft (- (car nextPt) (getvar "dimgap") txtlen))
(setq l2left textleft)
)
)
(vla-put-insertionpoint text (vlax-3d-point (list textleft (+ (cadr nextPt) (getvar "dimgap")) 0)))
(vla-update text)
(vla-put-startpoint l2 (vlax-3d-point nextPt))
(setq l2end (list l2left (cadr nextPt) 0))
(vla-put-endpoint l2 (vlax-3d-point l2end))
(vla-update l2)
)
)
)
((= readtype 3)
(setq hasMore nil)
)
((or (= 25 readtype) (= 13 readtype))
;(
)
)
)
)
页:
[1]