a170285 发表于 2011-4-7 20:24:19

本帖最后由 a170285 于 2011-4-7 20:33 编辑

回复 Gu_xl 的帖子

版主大大..好像不能运行
TT运行后..选择多段线后..就函数出错了
我就是想说弄一个这样的注记边长..
只要选择到是线就会自己标注出来居中.
不用闭合的线..版主能帮我么?
我不知道怎么能做的出来...
CAD系统自带的那个..标记出来就不能双击修改..所以不可以用那个..郁闷的很

Gu_xl 发表于 2011-4-7 20:29:29

回复 a170285 的帖子

程序开始添加一句：
(vl-load-com)

a170285 发表于 2011-4-7 20:35:44

回复 Gu_xl 的帖子

版主..可能我比较笨一点...我在最前面加了..还是不行?我加错地方?具体那个地方呢?
(vl-load-com)
(defun c:tt (/ obj pianju sHandlept np gx bj np xcrrcp n ang1 zjp ms AddText)
;;;构造text
(defun AddText (obj TextStringInsertionPointHeight 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 ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(while (setq pen (car (entsel "\n选择多段线：")))
(setq      bcHeight 0.28 ;_ 字高
      kgb         0.8 ;_ 宽高比
      Style         "standard" ;_ 字体
      ZJWS         2 ;_ 注记位数
      DimScale 1 ;_ 边长尺度，若单位为mm,该值为1000
      flag         nil ;_ 标注在多段线走向的右侧,T 左侧
) ;_ setq
(setq pianju (* bcHeight 0.7)) ;_ 边长离线距离
(setq obj (vlax-ename->vla-object pen)
      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 ZJWS)
            )
      (if flag
            (setq zjp (polar midpt (cond ((> bugle 0)(angle midpt cp))(t (anglecp midpt))) pianju))
            (setq zjp(polar midpt (cond ((> bugle 0)(anglecp 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 bczjpbcHeight 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 ZJWS)
            )
      (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 bczjpbcHeight ang1 kgb 0 acAlignmentMiddle Style)
      );progn
    ) ;_ 结束if
    (setq n (1+ n))
) ;_ 结束while
)
(princ)
)

Gu_xl 发表于 2011-4-7 20:51:59

本帖最后由 Gu_xl 于 2011-4-7 20:59 编辑

回复 a170285 的帖子

函数开始加一句常量设置
(setq pi2 (/ pi 2))
10楼已改！

a170285 发表于 2011-4-7 21:07:19

回复 Gu_xl 的帖子

版主..非常感谢你..
谢谢..真的很感谢..
我自己也会加强学习..尽快提高自己的水平..

香田里浪人 发表于 2014-1-15 19:45:16

Gu_xl 发表于 2011-4-7 18:54 static/image/common/back.gif
回复 a170285 的帖子

楼主程序是不错，可惜不能批量标注，如果能改成批量标注更好。

香田里浪人 发表于 2014-1-15 19:46:08

Gu_xl 发表于 2011-4-7 18:54 static/image/common/back.gif
回复 a170285 的帖子

版主程序是不错，可惜不能批量标注，如果能改成批量标注更好。

mpk023 发表于 2020-9-14 11:07:42

Gu_xl 发表于 2011-4-7 18:54
回复 a170285 的帖子

老师你的这个不能框选多个闭合的多段线吗
页: 1 [2]
查看完整版本: {已解决}问个注记建筑物边长的问题