多线段标注

o宠虫飞/;!★

多线段标注 要求字头统一朝上或朝左，而且在线内侧如图，怎么用程序实现？标注是好实现就是字头的方向和在线内的情况我搞不定，求高人指点，谢谢！!

ysq101

这个不算很难啊。。。自己找找   关于多线段

o宠虫飞/;!★

关键是 字头的方向  和在线内，而且线的方向是不固定的！

lucas_3333

1. (defun c:pdim(/ plSet pLlst vLst oldOsn cAng cDis cPt)
   
2.   (princ "\n<<< Select LwPolyline for dimensioning >>> ")
   
3.   (if(setq plSet(ssget '((0 . "LWPOLYLINE"))))
   
4.     (progn
   
5.       (setq pLlst(vl-remove-if 'listp
   
6.                          (mapcar 'cadr(ssnamex plSet)))
   
7.             oldOsn(getvar "OSMODE")
   
8.             ); end if
   
9.       (setvar "OSMODE" 0)(setvar "CMDECHO" 0)
   
10.       (command "_.undo" "_be")
    
11.       (foreach pl pLlst
    
12.         (setq vLst(mapcar '(lambda(x)
    
13.                    (trans x 0 1))(mapcar 'cdr
    
14.                      (vl-remove-if-not
    
15.                        '(lambda(x)(= 10(car x)))(entget pl))))
    
16.               ); end setq
    
17.         (if(equal '(70 . 1)(assoc 70(entget pl)))
    
18.           (setq vLst(append vLst(list(car vLst))))
    
19.           ); end if
    
20.         (while(< 1(length vLst))
    
21.           (setq cAng(angle(car vLst)(cadr vLst))
    
22.                 cDis(/(distance(car vLst)(cadr vLst))2))
    
23.           (if(>=(caar vLst)(caadr vLst))
    
24.             (setq cAng(- cAng pi))
    
25.             ); end if
    
26.           (setq cPt(polar
    
27.                      (polar(car vLst)cAng cDis)
    
28.                      (+ cAng(* 0.5 pi))(* 1.0(getvar "DIMTXT")))
    
29.                 ); end setq
    
30.           (command "_.dimaligned"(car vLst)(cadr vLst) cPt)
    
31.           (setq vLst(cdr vLst))
    
32.           ); end while
    
33.         ); end foreach
    
34.       (command "_.undo" "_e")
    
35.       (setvar "OSMODE" oldOsn)(setvar "CMDECHO" 1)
    
36.       ); end progn
    
37.     ); end if
    
38.   (princ)
    
39.   ); end of c:pdim

(defun c:pdim(/ plSet pLlst vLst oldOsn cAng cDis cPt)<br />   (princ "\n<<< Select LwPolyline for dimensioning >>> ")<br />   (if(setq plSet(ssget '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (setq pLlst(vl-remove-if 'listp<br />                          (mapcar 'cadr(ssnamex plSet)))<br />             oldOsn(getvar "OSMODE")<br />             ); end if<br />       (setvar "OSMODE" 0)(setvar "CMDECHO" 0)<br />       (command "_.undo" "_be")<br />       (foreach pl pLlst<br />         (setq vLst(mapcar '(lambda(x)<br />                    (trans x 0 1))(mapcar 'cdr<br />                      (vl-remove-if-not<br />                        '(lambda(x)(= 10(car x)))(entget pl))))<br />               ); end setq<br />         (if(equal '(70 . 1)(assoc 70(entget pl)))<br />           (setq vLst(append vLst(list(car vLst))))<br />           ); end if<br />         (while(< 1(length vLst))<br />           (setq cAng(angle(car vLst)(cadr vLst))<br />                 cDis(/(distance(car vLst)(cadr vLst))2))<br />           (if(>=(caar vLst)(caadr vLst))<br />             (setq cAng(- cAng pi))<br />             ); end if<br />           (setq cPt(polar<br />                      (polar(car vLst)cAng cDis)<br />                      (+ cAng(* 0.5 pi))(* 1.0(getvar "DIMTXT")))<br />                 ); end setq<br />           (command "_.dimaligned"(car vLst)(cadr vLst) cPt)<br />           (setq vLst(cdr vLst))<br />           ); end while<br />         ); end foreach<br />       (command "_.undo" "_e")<br />       (setvar "OSMODE" oldOsn)(setvar "CMDECHO" 1)<br />       ); end progn<br />     ); end if<br />   (princ)<br />   ); end of c:pdim

动手修该一下吧

o宠虫飞/;!★

标注倒是好上就是调整位置，感谢提供方法可是没达到效果。

byghbcx

稍微改了一下
(defun c:pdim(/ plSet pLlst vLst oldOsn cAng cDis cPt cen per)
  (princ "\n<<< Select LwPolyline for dimensioning >>> ")
  (if(setq plSet(ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq pLlst(vl-remove-if 'listp
                   (mapcar 'cadr(ssnamex plSet)))
            oldOsn(getvar "OSMODE")
            ); end if
      (setvar "OSMODE" 0)
      (setvar "CMDECHO" 0)
      (command "_.undo" "_be")
      (foreach pl pLlst
        (setq vLst(mapcar '(lambda(x)
                             (trans x 0 1))
                          (mapcar 'cdr
                                  (vl-remove-if-not
                                    '(lambda(x)(= 10(car x)))(entget pl))))
              ); end setq
        (if(equal '(70 . 1)(assoc 70(entget pl)))
          (setq vLst(append vLst(list(car vLst))))
          ); end if
        (setq cen  (list (/ (apply '+ (mapcar 'car vLst)) (length vLst))
                         (/ (apply '+ (mapcar 'cadr vLst)) (length vLst))
                         (/ (apply '+ (mapcar 'caddr vLst)) (length vLst)))
              )
        (while(< 1(length vLst))
          (setq cAng(angle(car vLst)(cadr vLst))
                cDis(/(distance(car vLst)(cadr vLst))2))
;;;          (if(>=(caar vLst)(caadr vLst))
;;;            (setq cAng(- cAng pi))
;;;            ); end if
          (setq cPt(polar
                     (setq cmid (polar(car vLst)cAng cDis))
                     (angle cmid cen) (* 2.0(getvar "DIMTXT")))
                ); end setq
          ;(command "_.dimaligned"(car vLst)(cadr vLst) cPt)
          (setq per (inters cen (polar cen (- cAng (* 0.5 pi)) 1) (car vLst) (cadr vLst) nil))          
          (command "_.text" cPt (* 2.0(getvar "DIMTXT")) (/ (* 180 (- (angle per cen) (* 0.5 pi))) pi) (rtos (distance(car vLst)(cadr vLst)) 2 2) )
          (setq vLst(cdr vLst))
          ); end while
        ); end foreach
      (command "_.undo" "_e")
      (setvar "OSMODE" oldOsn)(setvar "CMDECHO" 1)
      ); end progn
    ); end if
  (princ)
  ); end of c:pdim

edata

1. (defun c:tt(/ ANG1 ANG2 ANG3 ANG4 CEN DS12 DS23 DS34 DS41 ENT LL LST M12 M23 M34 M41 OBJ P1 P2 P3 P4 RR SS X Y)
   
2.   ;;返回多段线顶点表
   
3. (defun vertexs (ename / plist pp n)        
   
4.   (setq obj (vlax-ename->vla-object ename))
   
5.   (setq plist (vlax-safearray->list
   
6.   (vlax-variant-value
   
7.     (vla-get-coordinates obj))))
   
8.   (setq n 0)
   
9.   (repeat (/ (length plist) 2)
   
10.     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
    
11.     (setq n (+ n 2))
    
12.   )
    
13.   pp
    
14. )
    
15.   (if(setq ss(ssget '((0 . "lwpolyline") (90 . 4)(70 . 1))))          
    
16.     (while (setq ent(ssname ss 0))
    
17.       (progn
    
18.       (setq lst(vertexs ent)
    
19.             p1(car lst)
    
20.             p2(cadr lst)
    
21.             p3(caddr lst)
    
22.             p4(cadddr lst)
    
23.             ll(apply 'mapcar (list 'min p1 p2 p3 p4))
    
24.             rr(apply 'mapcar (list 'max p1 p2 p3 p4))
    
25.             p1 ll
    
26.             p3 rr
    
27.             p2 (list(car p3)(cadr p1))
    
28.             p4 (list(car p1)(cadr p3))
    
29.             cen(mapcar '(lambda(x y)(* (+ x y) 0.5)) p1 p3)
    
30.             m12(mapcar '(lambda(x y)(* (+ x y) 0.5)) p1 p2)
    
31.             m23(mapcar '(lambda(x y)(* (+ x y) 0.5)) p2 p3)
    
32.             m34(mapcar '(lambda(x y)(* (+ x y) 0.5)) p3 p4)
    
33.             m41(mapcar '(lambda(x y)(* (+ x y) 0.5)) p4 p1)
    
34.             ds12(distance p1 p2)
    
35.             ds23(distance p2 p3)
    
36.             ds34(distance p3 p4)
    
37.             ds41(distance p4 p1)
    
38.             ang1 0
    
39.             ang2 (* 0.5 pi)
    
40.             ang3 0
    
41.             ang4 (* 0.5 pi)            
    
42.             )
    
43.       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 1)(cons 50 ang1) (cons 1 (rtos ds12 2 2)) (cons 10 m12)(cons 11 m12) (cons 40 (* ds12 0.025))))
    
44.       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 1)(cons 50 ang2) (cons 1 (rtos ds23 2 2)) (cons 10 m23)(cons 11 m23) (cons 40 (* ds12 0.025))))
    
45.       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 3)(cons 50 ang3)(cons 1 (rtos ds34 2 2)) (cons 10 m34)(cons 11 m34) (cons 40 (* ds12 0.025))))
    
46.       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 3)(cons 50 ang4) (cons 1 (rtos ds41 2 2)) (cons 10 m41)(cons 11 m41) (cons 40 (* ds12 0.025))))      
    
47.       )
    
48.       (setq ss(ssdel ent ss))
    
49.     )
    
50.     )
    
51.   (princ)
    
52.   )

(defun c:tt(/ ANG1 ANG2 ANG3 ANG4 CEN DS12 DS23 DS34 DS41 ENT LL LST M12 M23 M34 M41 OBJ P1 P2 P3 P4 RR SS X Y)<br />   ;;返回多段线顶点表<br /> (defun vertexs (ename / plist pp n)        <br />   (setq obj (vlax-ename->vla-object ename))<br />   (setq plist (vlax-safearray->list<br />   (vlax-variant-value<br />     (vla-get-coordinates obj))))<br />   (setq n 0)<br />   (repeat (/ (length plist) 2)<br />     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))<br />     (setq n (+ n 2))<br />   )<br />   pp<br /> )<br />   (if(setq ss(ssget '((0 . "lwpolyline") (90 . 4)(70 . 1))))          <br />     (while (setq ent(ssname ss 0))<br />       (progn<br />       (setq lst(vertexs ent)<br />             p1(car lst)<br />             p2(cadr lst)<br />             p3(caddr lst)<br />             p4(cadddr lst)<br />             ll(apply 'mapcar (list 'min p1 p2 p3 p4))<br />             rr(apply 'mapcar (list 'max p1 p2 p3 p4))<br />             p1 ll<br />             p3 rr<br />             p2 (list(car p3)(cadr p1))<br />             p4 (list(car p1)(cadr p3))<br />             cen(mapcar '(lambda(x y)(* (+ x y) 0.5)) p1 p3)<br />             m12(mapcar '(lambda(x y)(* (+ x y) 0.5)) p1 p2)<br />             m23(mapcar '(lambda(x y)(* (+ x y) 0.5)) p2 p3)<br />             m34(mapcar '(lambda(x y)(* (+ x y) 0.5)) p3 p4)<br />             m41(mapcar '(lambda(x y)(* (+ x y) 0.5)) p4 p1)<br />             ds12(distance p1 p2)<br />             ds23(distance p2 p3)<br />             ds34(distance p3 p4)<br />             ds41(distance p4 p1)<br />             ang1 0<br />             ang2 (* 0.5 pi)<br />             ang3 0<br />             ang4 (* 0.5 pi)            <br />             )<br />       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 1)(cons 50 ang1) (cons 1 (rtos ds12 2 2)) (cons 10 m12)(cons 11 m12) (cons 40 (* ds12 0.025))))<br />       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 1)(cons 50 ang2) (cons 1 (rtos ds23 2 2)) (cons 10 m23)(cons 11 m23) (cons 40 (* ds12 0.025))))<br />       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 3)(cons 50 ang3)(cons 1 (rtos ds34 2 2)) (cons 10 m34)(cons 11 m34) (cons 40 (* ds12 0.025))))<br />       (entmake (list '(0 . "TEXT")'(72 . 1)(cons 73 3)(cons 50 ang4) (cons 1 (rtos ds41 2 2)) (cons 10 m41)(cons 11 m41) (cons 40 (* ds12 0.025))))      <br />       )<br />       (setq ss(ssdel ent ss))<br />     )<br />     )<br />   (princ)<br />   )

lucas_3333

edata 发表于 2014-5-13 17:02

E大，这个只能标矩形吧

香田里浪人

;;;多义线边长标注
(defun c:bcbz (/ obj pianju sHandle  pt np gx bj np xc  rr  cp n ang1 zjp ms AddText pen-n pen-all)
;;;构造text
(command "layer" "M" "边长标注" "C" "6" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(command "style" "hz" "宋体" "0" "" "0" "" "")
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
  (defun AddText (obj TextString  InsertionPoint  Height xz kb qx Alignment style / obj1 err)
  (setq obj1 (vla-addtext obj TextString  (vlax-3d-point InsertionPoint)  Height))
  (vla-put-Rotation obj1 xz)
  (vla-put-ScaleFactor obj1 kb)
  (vla-put-ObliqueAngle obj1 qx)
  (vla-put-alignment obj1 Alignment)
  (if (/= Alignment acAlignmentLeft)
    (vla-put-TextAlignmentPoint obj1 (vlax-3d-point InsertionPoint))
    (vla-put-InsertionPoint obj1 (vlax-3d-point InsertionPoint))
   )
   (VL-CATCH-ALL-APPLY 'vla-put-StyleName (list obj1 style))
  obj1
  )
(setq pi2 (/ pi 2))
  (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq  bcHeight (getdist "\n输入标注文字高度:");文字高度
        kgb         0.60 ; 宽高比
      DimScale 1 ; 边长尺度，若单位为mm,该值为1000
        flag        nil;nil标注在多段线走向的右侧,T 左侧
) ;_ setq
(setq pen-n 0)
(if (setq pen-all (ssget '((0 . "*polyline"))))
    (repeat (sslength pen-all)
            (setq pianju (* bcHeight 0.7)) ;边长离线距离
            (setq pen-en (ssname pen-all pen-n))
            (setq obj (vlax-ename->vla-object pen-en)
                  n 0)
              (while (and (setq pt (vlax-curve-getPointAtParam obj n))
              (setq np (vlax-curve-getPointAtParam obj (1+ n)))
         ) ;_ 结束and
    (if        (/= 0.0 (setq bugle (vla-GetBulge obj n)))
      (progn
        (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
             bj (* (atan (abs bugle)) 4)
            xc (* 0.5 (distance Pt np))
            gg (abs (* bugle xc))
            rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
            ang1 (angle pt np)
            cp (polar Pt ang1 xc)
            cp (polar midpt (angle midpt cp) rr)
            bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale) 2 2)
              )
       (if flag
            (setq zjp (polar midpt (cond ((> bugle 0)(angle midpt cp))(t (angle  cp midpt))) pianju))
            (setq zjp  (polar midpt (cond ((> bugle 0)(angle  cp midpt))(t (angle midpt cp))) pianju))
     )
        (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (< ang1 (* 2.0 pi)))))
         (setq ang1 (- ang1 pi))
          )
        (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
     );progn
      (progn
        (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
              ang1 (angle pt np)
              bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale)  2 2)
              )
        (if flag
            (setq zjp (polar midpt (+ pi2 ang1) pianju))
          (setq zjp (polar midpt (- ang1 pi2) pianju))
               )
        (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (<= ang1 (* 2.0 pi)))))
          (setq ang1 (- ang1 pi))
          )
        (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
      );progn
    ) ;结束if
    (setq n (1+ n))
  ) ; 结束while
  (setq pen-n (1+ pen-n)))
)
  (princ)
  )

bai2000

楼上，能不能改下，对直线也适用？