如何实现获取一段线的长度，并用单行文字标注距离？

我来看MM的

新手求教！！！

我来看MM的

补充：并且可以设置单行文字的样式，标注最好能和线的走向一致！
求教了！！！

我来看MM的

坐等

我来看MM的

【KAIXIN】

   是不是这样的效果？

下楼是源码，你想怎么设置就怎么设置

【KAIXIN】

2. ;选线对齐标注
   
3. (defun c:KK()
   
4.      (setvar "cmdecho" 0) ;指令执行过程不响应
   
5.      (PRINC "\n选线对齐标注功能")
   
6.     (setq k (getvar "CLAYER"))
   
7. (command "style" "宋体" "宋体" "0" "1" "0" "" "")
   
8.   (command "dimtxt"   "2.5"         "dimasz"   "2"      "dimexe"
   
9.            ".5"              "dimexo"         "0.5"            "dimgap"   "0.5"
   
10.            "dimtoh"   "off"         "dimtih"   "OFF"      "blipmode"
    
11.            "0"              "DIMDLI"         "5"            "DIMATFIT" "3"
    
12.            "DIMTAD"   "0"         "DIMDEC"   "2"               "DIMTXSTY"
    
13.            "宋体"   "DIMCLRT"         "6"            "DIMJUST"  "0"
    
14.            "DIMDSEP"  "."         "DIMTOFL"  "0" "dimtmove" "0"
    
15.            "dimcen" "0" "dimclrd" "3" "dimclre" "5"
    
16.           )
    
17. (setq layer "标注     dim")(if (not (tblsearch "layer" layer ))
    
18. 
    
19.   (progn (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
    
20. 
    
21. ))
    
22.      (setvar  "CLAYER" layer)  
    
23. (command "_dimaligned" "")
    
24.      (setvar  "CLAYER" k)
    
25. (PRINC))
    

;选线对齐标注<br /> (defun c:KK()<br />      (setvar "cmdecho" 0) ;指令执行过程不响应<br />      (PRINC "\n选线对齐标注功能")<br />     (setq k (getvar "CLAYER"))<br /> (command "style" "宋体" "宋体" "0" "1" "0" "" "")<br />   (command "dimtxt"   "2.5"         "dimasz"   "2"      "dimexe"<br />            ".5"              "dimexo"         "0.5"            "dimgap"   "0.5"<br />            "dimtoh"   "off"         "dimtih"   "OFF"      "blipmode"<br />            "0"              "DIMDLI"         "5"            "DIMATFIT" "3"<br />            "DIMTAD"   "0"         "DIMDEC"   "2"               "DIMTXSTY"<br />            "宋体"   "DIMCLRT"         "6"            "DIMJUST"  "0"<br />            "DIMDSEP"  "."         "DIMTOFL"  "0" "dimtmove" "0"<br />            "dimcen" "0" "dimclrd" "3" "dimclre" "5" <br />           )<br /> (setq layer "标注     dim")(if (not (tblsearch "layer" layer ))<br /> <br />   (progn (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")<br /> <br /> ))<br />      (setvar  "CLAYER" layer)  <br /> (command "_dimaligned" "")<br />      (setvar  "CLAYER" k) <br /> (PRINC))<br />

xiaxiang

2. (defun c:plLen (/ cEnt tStr tBox tHgt tWid gr sPt
   
3.                   cPt lAng bPt tPt pt1 pt2 pt3 pt4)
   
4.   (vl-load-com)
   
5.   (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
   
6.            (member (cdr (assoc 0 (entget cEnt)))
   
7.                    '("LWPOLYLINE" "POLYLINE" "LINE")))
   
8.     (progn
   
9.       (setq tStr (rtos (vla-get-length
   
10.                          (vlax-ename->vla-object cEnt)) 2 2)
    
11.           tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
    
12.           tHgt (- (cadadr tBox) (cadar tBox))
    
13.           twid (- (caadr tBox) (caar tBox)))
    
14.       (princ "\nPosition Text...")
    
15.       (while (eq 5 (car (setq gr (grread t 5 0))))
    
16.         (redraw)
    
17.         (if (listp (setq sPt (cadr gr)))
    
18.           (progn
    
19.             (setq cPt (vlax-curve-getClosestPointto cEnt sPt)
    
20.                   lAng (angle cPt sPt)
    
21.                   bpt (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
    
22.                   tpt (polar bpt lAng tHgt)
    
23.                   mPt (polar bPt lAng (/ tHgt 2.))
    
24.                   pt1 (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
    
25.                   pt2 (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
    
26.                   pt3 (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
    
27.                   pt4 (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
    
28.             (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
    
29.       (if (eq 3 (car gr))
    
30.         (progn
    
31.           (setq lAng (- lAng (/ pi 2.)))
    
32.           (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
    
33.              (setq lAng (- lAng pi)))
    
34.             ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
    
35.              (setq lAng (+ lAng pi))))
    
36.           (Make_Text mPt tStr lAng))))
    
37.     (princ "\n<!> Incorrect Selection <!>"))
    
38.   (redraw)
    
39.   (princ))
    
40. 
    
41. (defun Make_Text  (pt val rot)
    
42.   (entmake
    
43.     (list
    
44.       (cons 0 "TEXT")
    
45.       (cons 8 (getvar "CLAYER"))
    
46.       (cons 62 2)
    
47.       (cons 10 pt)
    
48.       (cons 40 (getvar "TEXTSIZE"))
    
49.       (cons 1 val)
    
50.       (cons 50 rot)
    
51.       (cons 7 (getvar "TEXTSTYLE"))
    
52.       (cons 71 0)
    
53.       (cons 72 1)
    
54.       (cons 73 2)
    
55.       (cons 11 pt))))

(defun c:plLen (/ cEnt tStr tBox tHgt tWid gr sPt<br />                   cPt lAng bPt tPt pt1 pt2 pt3 pt4)<br />   (vl-load-com)<br />   (if (and (setq cEnt (car (entsel "\nSelect Object: ")))<br />            (member (cdr (assoc 0 (entget cEnt)))<br />                    '("LWPOLYLINE" "POLYLINE" "LINE")))<br />     (progn<br />       (setq tStr (rtos (vla-get-length<br />                          (vlax-ename->vla-object cEnt)) 2 2)<br />           tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))<br />           tHgt (- (cadadr tBox) (cadar tBox))<br />           twid (- (caadr tBox) (caar tBox)))<br />       (princ "\nPosition Text...")<br />       (while (eq 5 (car (setq gr (grread t 5 0))))<br />         (redraw)<br />         (if (listp (setq sPt (cadr gr)))<br />           (progn<br />             (setq cPt (vlax-curve-getClosestPointto cEnt sPt)<br />                   lAng (angle cPt sPt)<br />                   bpt (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))<br />                   tpt (polar bpt lAng tHgt)<br />                   mPt (polar bPt lAng (/ tHgt 2.))<br />                   pt1 (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))<br />                   pt2 (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))<br />                   pt3 (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))<br />                   pt4 (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))<br />             (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))<br />       (if (eq 3 (car gr))<br />         (progn<br />           (setq lAng (- lAng (/ pi 2.)))<br />           (cond ((and (> lAng (/ pi 2)) (<= lAng pi))<br />              (setq lAng (- lAng pi)))<br />             ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))<br />              (setq lAng (+ lAng pi))))<br />           (Make_Text mPt tStr lAng))))<br />     (princ "\n<!> Incorrect Selection <!>"))<br />   (redraw)<br />   (princ))<br /> <br /> (defun Make_Text  (pt val rot)<br />   (entmake<br />     (list<br />       (cons 0 "TEXT")<br />       (cons 8 (getvar "CLAYER"))<br />       (cons 62 2)<br />       (cons 10 pt)<br />       (cons 40 (getvar "TEXTSIZE"))<br />       (cons 1 val)<br />       (cons 50 rot)<br />       (cons 7 (getvar "TEXTSTYLE"))<br />       (cons 71 0)<br />       (cons 72 1)<br />       (cons 73 2)<br />       (cons 11 pt))))

FUShouyin

1. 
   
2. (defun c:tt()
   
3.   (SETVAR "CMDECHO" 0)
   
4.   (GRAPHSCR)
   
5.   (command "style" "仿宋" "仿宋" "0" "0.7" "0" "" "")
   
6.   (setq  size_text(getvar "textsize") dist_text 600)
   
7.     (setq ds1 (getdist (strcat "\n输入字高["(rtos size_text)"]:")))
   
8.    (if (= ds1 nil)
   
9.    (princ (strcat "\n字高:["(rtos size_text)"]"))
   
10.    (setq size_text ds1)
    
11.   )  
    
12.   (setq ds2 (getdist (strcat "\n输入文字离线距离["(rtos dist_text)"]:")))
    
13.    (if (= ds2 nil)
    
14.    (princ (strcat "\n文字离线距离:["(rtos dist_text)"]"))
    
15.    (setq dist_text ds2)
    
16.   )
    
17.      (setq i 0)
    
18.      (princ "\n选取直线对象... ")
    
19.      (if (setq ss (ssget '((0 . "line"))))
    
20.   (repeat (sslength ss)
    
21.      (setq ent  (entget (ssname ss i))
    
22.     pt0 (cdr (assoc 10 ent))
    
23.     pt1 (cdr (assoc 11 ent))
    
24.     pt0 (trans pt0 0 1) ;_转换为用户坐标系下
    
25.     pt1 (trans pt1 0 1)
    
26.      pt 0
    
27.    )     
    
28.      (if (> (car pt0) (car pt1))
    
29.    (setq tmp pt0
    
30.          pt0 pt1
    
31.          pt1 tmp
    
32.    ))
    
33. ;;计算文字标注位置
    
34.     (setq dist (distance pt0 pt1)
    
35.    ang  (angle pt0 pt1)
    
36.   str (rtos dist 2 2)
    
37.     )
    
38.     (setq pt (polar pt0 ang (* 0.5 dist))
    
39.    pt (polar pt (+ ang (* 0.5 pi)) dist_text)
    
40.     )
    
41. ;;写文字
    
42.     (COMMAND "_.TEXT"
    
43.    "j"
    
44.    "bc"
    
45.    "non"
    
46.    pt
    
47.    size_text
    
48.    (* (/ ang pi) 180)
    
49.    str
    
50.      )   
    
51.      (setq i (1+ i))
    
52. )
    
53.     )
    
54.     (princ)
    
55. )
    

<br /> (defun c:tt()<br />   (SETVAR "CMDECHO" 0)<br />   (GRAPHSCR)<br />   (command "style" "仿宋" "仿宋" "0" "0.7" "0" "" "")<br />   (setq  size_text(getvar "textsize") dist_text 600)<br />     (setq ds1 (getdist (strcat "\n输入字高["(rtos size_text)"]:")))<br />    (if (= ds1 nil) <br />    (princ (strcat "\n字高:["(rtos size_text)"]"))<br />    (setq size_text ds1)<br />   )  <br />   (setq ds2 (getdist (strcat "\n输入文字离线距离["(rtos dist_text)"]:")))<br />    (if (= ds2 nil) <br />    (princ (strcat "\n文字离线距离:["(rtos dist_text)"]"))<br />    (setq dist_text ds2)<br />   )<br />      (setq i 0)<br />      (princ "\n选取直线对象... ")<br />      (if (setq ss (ssget '((0 . "line"))))<br />   (repeat (sslength ss)<br />      (setq ent  (entget (ssname ss i))<br />     pt0 (cdr (assoc 10 ent))<br />     pt1 (cdr (assoc 11 ent))<br />     pt0 (trans pt0 0 1) ;_转换为用户坐标系下<br />     pt1 (trans pt1 0 1)<br />      pt 0<br />    )     <br />      (if (> (car pt0) (car pt1))<br />    (setq tmp pt0<br />          pt0 pt1<br />          pt1 tmp<br />    ))<br /> ;;计算文字标注位置<br />     (setq dist (distance pt0 pt1)<br />    ang  (angle pt0 pt1)<br />   str (rtos dist 2 2)<br />     )<br />     (setq pt (polar pt0 ang (* 0.5 dist))<br />    pt (polar pt (+ ang (* 0.5 pi)) dist_text)<br />     )<br /> ;;写文字<br />     (COMMAND "_.TEXT"<br />    "j"<br />    "bc"<br />    "non"<br />    pt<br />    size_text<br />    (* (/ ang pi) 180)<br />    str<br />      )   <br />      (setq i (1+ i))<br /> )<br />     )<br />     (princ)<br /> )<br />

flytoday

很强大顶上~~~~~~~~~~~~~

【KAIXIN】

xiaxiang 发表于 2011-12-2 17:13

如果整成批量的就强大了