[求助]ZZXXQQ朋友，您改后的"线上插字符"还有点小问题

xd-xdcad

怎样达到图示效果呢?

执行命令

输入字高

输入内容

连续插入

谢谢

carrot1983

你不是达到了？

xd-xdcad

carrot1983发表于2008-6-16 15:21:00你不是达到了？

这是一个大程序中的部分，带狗的,其他内容我是不需要的,而相关的内容我也不能察看，美中不足是该命令仅适合LINE,最好也能适合PLINE,所以单独求助编写一个

carrot1983

http://carrot1983.blog.sohu.com/82096186.html

应该可以满足你的需要

xd-xdcad

carrot1983发表于2008-6-16 17:07:00http://carrot1983.blog.sohu.com/82096186.html应该可以满足你的需要

挺好的，适合范围很大呀，美中不足有两点

1、输入的字符、包括字高不能默认保存，以备重复使用

2、字符仅能一次输入1个，不能重复插入，毕竟大多数情况下都在重复插入这种环境下使用的

方便更改一下吗,谢谢

xd-xdcad

carrot1983的好程序

如果能改成输入一次文字内容、字高，然后即可随意多点插入就完美了

请高手指点，谢谢

ZZXXQQ

3. ;;;CurveAngle
4. (defun CurveAngle (ENAME P / ANG OBJECT P P1 TAN)
5. (setq object (vlax-ename->vla-object ename))
6. (setq tan (vlax-Curve-GetFirstDeriv
7.        object (vlax-Curve-GetParamatDist object (vlax-curve-getDistAtPoint object p))
8.         )
9. )
10. (setq p1 (polar p (atan (/ (cadr tan) (car tan))) 1))
11. (setq ang (if (= (car tan) 0) 0 (angle p1 p)))
12. (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))
13.   (setq ang (- ang pi)) ;_始终取锐角
14. )
15. ang
16. )
17. ;;getbox
18. (defun getbox (e / BL BMAX BMIN BR BUTTOMX BUTTOMY TL TOPX TOPY TR)
19. (vla-GetBoundingBox (vlax-ename->vla-object e) 'bmin 'bmax)
20. (setq bmin (vlax-safearray->list bmin)
21.        bmax (vlax-safearray->list bmax)
22.        buttomx (car bmin)
23.        buttomy (cadr bmin)
24.        topx (car bmax)
25.        topy (cadr bmax)
26.        bl bmin
27.        br (list topx buttomy)
28.        tr bmax
29.        tl (list buttomx topy))
30. (list bl br tr tl)
31. )
32. ;;;GetInters
33. (defun GetInters (e1 e2 / 3DJD 3DJDLST SAFEJDLST VARJD)
34. (setq o1 (vlax-ename->vla-object e1))
35. (setq o2 (vlax-ename->vla-object e2))
36. (setq varjd (vla-intersectwith o1 o2 acExtendnone))
37. (if (> (vlax-safearray-get-u-bound (vlax-variant-value varjd) 1) 1) (progn
38.   (setq safejdlst (vlax-safearray->list (vlax-variant-value varjd)))
39.       ;;safearray数组转换为list表
40.   (setq i 0
41.         3djdlst nil)
42.   (repeat (/ (length safejdlst) 3)
43.    (setq 3djd (list (nth i safejdlst) (nth (+ 1 i) safejdlst)
44.              (nth (+ 2 i) safejdlst)))
45.    (setq 3djdlst (cons 3djd 3djdlst))
46.    (setq i (+ 3 i))
47.   )
48.   3djdlst
49. )
50.   nil
51. )
52. )
53. ;;;textinline 文字插线 carrot1983 2008.03
54. (defun c:textinline ()
55. (vl-load-com)
56. (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
57. (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
58.   (setq acsp (vla-get-paperspace adoc))
59.   (setq acsp (vla-get-modelspace adoc))
60. )
61. (if (/= (setq txt (getstring "\n输入文字<退出>: ")) "")
62.   (while (and (setq p (getpoint "\n请拾取文字插线上的一点<退出>:")) ;_曲线拾取的点p
63.        (setq p (osnap p "NEA")))
64.    (setq h (getdist p "\n指定文字高度<3.0>: "))
65.    (if (null h) (setq h 3.0))
66.    (if (setq ss (ssget p '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))) (progn
67.     (setq ename (ssname ss 0))
68.       ;;建立文字
69.     (setq ang (CurveAngle ename p))
70.     (setq txtobj (vlax-invoke acsp 'Addtext txt p h))
71.     (vla-put-Rotation txtobj ang)
72.     (setq alignmentPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
73.     (vlax-safearray-fill alignmentPnt p)
74.     (vla-put-alignment txtobj acAlignmentMiddle)
75.     (vla-put-InsertionPoint txtobj alignmentPnt)
76.     (vla-put-TextAlignmentPoint txtobj alignmentPnt)
77.     (setq txtename (vla-object->ename.htm target=_black>vlax-vla-object->ename txtobj))
78.       ;;建立矩形     
79.     (setq txtbox (getbox txtename))
80.     (setq ptlst (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) txtbox)))
81.     (setq arraySpace
82.          (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
83.     )
84.     (setq pnts (vlax-safearray-fill arraySpace ptlst))
85.     (vlax-make-variant pnts)
86.     (setq PLObj (vla-AddLightWeightPolyline acsp pnts))
87.     (vla-put-Closed PLObj :vlax-true)
88.     (setq elast (entlast))
89.       ;;=============
90.     (setq iplst (GetInters ename elast))
91.     (command "._break" ename (car iplst) (cadr iplst))
92.     (vla-erase (vlax-ename->vla-object elast))
93.    )
94.     (princ "\n安全退出")
95.    )
96.   )
97. )
98. (princ)
99. )

;;;CurveAngle (defun CurveAngle (ENAME P / ANG OBJECT P P1 TAN) (setq object (vlax-ename->vla-object ename)) (setq tan (vlax-Curve-GetFirstDeriv        object (vlax-Curve-GetParamatDist object (vlax-curve-getDistAtPoint object p))         ) ) (setq p1 (polar p (atan (/ (cadr tan) (car tan))) 1)) (setq ang (if (= (car tan) 0) 0 (angle p1 p))) (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))   (setq ang (- ang pi)) ;_始终取锐角 ) ang ) ;;getbox (defun getbox (e / BL BMAX BMIN BR BUTTOMX BUTTOMY TL TOPX TOPY TR) (vla-GetBoundingBox (vlax-ename->vla-object e) 'bmin 'bmax) (setq bmin (vlax-safearray->list bmin)        bmax (vlax-safearray->list bmax)        buttomx (car bmin)        buttomy (cadr bmin)        topx (car bmax)        topy (cadr bmax)        bl bmin        br (list topx buttomy)        tr bmax        tl (list buttomx topy)) (list bl br tr tl) ) ;;;GetInters (defun GetInters (e1 e2 / 3DJD 3DJDLST SAFEJDLST VARJD) (setq o1 (vlax-ename->vla-object e1)) (setq o2 (vlax-ename->vla-object e2)) (setq varjd (vla-intersectwith o1 o2 acExtendnone)) (if (> (vlax-safearray-get-u-bound (vlax-variant-value varjd) 1) 1) (progn   (setq safejdlst (vlax-safearray->list (vlax-variant-value varjd)))       ;;safearray数组转换为list表   (setq i 0         3djdlst nil)   (repeat (/ (length safejdlst) 3)    (setq 3djd (list (nth i safejdlst) (nth (+ 1 i) safejdlst)              (nth (+ 2 i) safejdlst)))    (setq 3djdlst (cons 3djd 3djdlst))    (setq i (+ 3 i))   )   3djdlst )   nil ) ) ;;;textinline 文字插线 carrot1983 2008.03 (defun c:textinline () (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))   (setq acsp (vla-get-paperspace adoc))   (setq acsp (vla-get-modelspace adoc)) ) (if (/= (setq txt (getstring "\n输入文字<退出>: ")) "")   (while (and (setq p (getpoint "\n请拾取文字插线上的一点<退出>:")) ;_曲线拾取的点p        (setq p (osnap p "NEA")))    (setq h (getdist p "\n指定文字高度<3.0>: "))    (if (null h) (setq h 3.0))    (if (setq ss (ssget p '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))) (progn     (setq ename (ssname ss 0))       ;;建立文字     (setq ang (CurveAngle ename p))     (setq txtobj (vlax-invoke acsp 'Addtext txt p h))     (vla-put-Rotation txtobj ang)     (setq alignmentPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))     (vlax-safearray-fill alignmentPnt p)     (vla-put-alignment txtobj acAlignmentMiddle)     (vla-put-InsertionPoint txtobj alignmentPnt)     (vla-put-TextAlignmentPoint txtobj alignmentPnt)     (setq txtename (vla-object->ename.htm target=_black>vlax-vla-object->ename txtobj))       ;;建立矩形          (setq txtbox (getbox txtename))     (setq ptlst (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) txtbox)))     (setq arraySpace          (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))     )     (setq pnts (vlax-safearray-fill arraySpace ptlst))     (vlax-make-variant pnts)     (setq PLObj (vla-AddLightWeightPolyline acsp pnts))     (vla-put-Closed PLObj :vlax-true)     (setq elast (entlast))       ;;=============     (setq iplst (GetInters ename elast))     (command "._break" ename (car iplst) (cadr iplst))     (vla-erase (vlax-ename->vla-object elast))    )     (princ "\n安全退出")    )   ) ) (princ) )

xd-xdcad

 错误: no function definition: VLA-OBJECT->ENAME

执行命令效果如图,插入文字的地方直线没有删除,并且还是仅能输入一个文字

谢谢

xd-xdcad

高手在,改的醒目的标题

xd-xdcad

(setq txtename (vla-object->ename.htm target=_black>vlax-vla-object->ename txtobj))
改成

(setq txtename (vlax-vla-object->ename txtobj)),可以执行了

但还有一个问题,命令行内总是出现提示"指定文字高度<3.0>",改成提示一次就更好了