明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: xiaodao520

悬赏50币,求写梁线标注。

  [复制链接]
发表于 2012-5-21 16:39:29 | 显示全部楼层
本帖最后由 flytoday 于 2012-5-21 16:44 编辑

兄弟有源码奉献不哈,。。
这种太强大了~~

明经中,绝无仅有的。建筑类自动标注~~
回复

使用道具 举报

发表于 2012-5-21 17:02:20 | 显示全部楼层
...............
回复

使用道具 举报

发表于 2012-5-21 18:40:26 | 显示全部楼层
在公司里写的,明天要出差,过两天再把源码放上来。

评分

参与人数 1明经币 +1 收起 理由
flytoday + 1 兄弟太强大了。。静候源码~

查看全部评分

回复

使用道具 举报

发表于 2012-5-21 22:44:52 | 显示全部楼层
等待!!!!!!!!!!!
回复

使用道具 举报

发表于 2012-5-23 10:49:51 | 显示全部楼层
源码已经交给楼主了,由楼主来决定是否放出来吧~

评分

参与人数 1明经币 +1 收起 理由
flytoday + 1 很给力!如果还能加上封闭线框那种也能适用就.

查看全部评分

回复

使用道具 举报

发表于 2012-5-23 11:27:10 来自手机 | 显示全部楼层
贴出来是应该滴………楼主哪去了
回复

使用道具 举报

 楼主| 发表于 2012-5-23 12:26:37 | 显示全部楼层
本帖最后由 xiaodao520 于 2012-5-23 12:30 编辑
flytoday 发表于 2012-5-23 11:27
贴出来是应该滴………楼主哪去了


客兄,偶哪里有这么多时间泡论坛,源码马上贴出来。
回复

使用道具 举报

 楼主| 发表于 2012-5-23 12:27:32 | 显示全部楼层
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                                ;;;
;;;                          梁尺寸标注程序,执行命令名: LBZ                        ;;;
;;;                                                                                ;;;
;;;                                                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq lbz_offset 300.0) ;;;默认偏移距离

(defun c:lbz (/            ss          tmp        n     na    ent          e10        e11   pt
              llst  oldos lst        e40   e50   e0          ob        len   pt1
              pt2   adlst lna        lay   ltype sslst e6    col   e62 ang
             )
;;;这是子函数部分;;;
  ;;;检查梁线是否已经进行了标注
  (defun noInLst (lst ptlst / rel n itm)
    (setq rel t
          n 0
    )
    (if        lst
      (progn
        (while (and rel
                    (setq itm (nth n lst))
               )
          (setq n (1+ n))
          (if (and (equal (DISTANCE (car itm) (cadr itm))
                          (DISTANCE (car ptlst) (cadr ptlst))
                          1.0
                   )
                   (equal ptlst itm 310.0)
              )
            (setq rel nil)
          )
        )
      )
    )
    rel
  )
  ;;;选择集转换成列表
  (defun hb_ssToLst (ss / na ent ena n rel)
    (setq n 0)
    (repeat (sslength ss)
      (setq na        (ssname ss n)
            ent        (entget na)
            ena        (cdr (assoc -1 ent))
      )
      (setq rel        (cons ena rel)
            n        (1+ n)
      )
    )
    (reverse rel)
  )
;;;子函数部分结束

;;;主程序开始
  (setvar "CMDECHO" 0)
  (setq oldos (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "_.UNDO" "BE")
  (if (setq lna (entsel "\n选择梁所在图层目标:<梁虚线>"))
    (setq ent (entget (car lna))
          lay (cdr (assoc 8 ent))         ;_指定图层
          ltype(assoc 6 ent)                ;_指定线型
          col (assoc 62 ent)                ;_指定颜色
    )
    (setq lay "梁虚线")
  )
  (princ (strcat "\n当前标注梁图层*** " lay " ***"))
  (if ltype
    (setq sslst (list (cons 0 "LINE,ARC") ltype (cons 8 lay)))
    (setq sslst (list (cons 0 "LINE,ARC") (cons 8 lay)))
  )
  (if (setq ss (ssget sslst))
    (progn
      (if (setq        tmp (getdist (strcat "\n请输入尺寸偏移距离:<"
                                     (rtos lbz_offset 2)
                                     ">"
                             )
                    )
          )
        (setq lbz_offset tmp)
      )
      (setq lst        (HB_SSTOLST ss)
            lst        (vl-sort lst
                         '(lambda (a b)
                            (< (car (cdr (assoc 10 (entget a))))
                               (car (cdr (assoc 10 (entget b))))
                            )
                          )
                )
            lst        (vl-sort lst
                         '(lambda (a b)
                            (> (cadr (cdr (assoc 10 (entget a))))
                               (cadr (cdr (assoc 10 (entget b))))
                            )
                          )
                )
      ) ;_将所选线条按从上到下,左到右的方向排序
      (setq n 0)
      (repeat (length lst)
        (setq na  (nth n lst)
              ent (entget na)
              e0  (cdr (assoc 0 ent))
              e6 (assoc 6 ent)
              e62 (assoc 62 ent)
              n          (1+ n)
        )
        (cond
          ((and (= e0 "LINE")(equal ltype e6)(equal col e62)) ;_判断与源物体是否同颜色,同线型
           (setq e10 (cdr (assoc 10 ent))
                 e11 (cdr (assoc 11 ent))
           )
           (setq adlst (vl-sort        (list e10 e11)
                                '(lambda (a b) (< (car a) (car b)))
                       )
                 adlst (vl-sort adlst '(lambda (a b) (< (cadr a) (cadr b))))
           )
           (if (noInLst llst adlst)
             (progn
               (setq llst (cons adlst llst))
               (if (< (abs (- (car e10) (car e11)))
                      (abs (- (cadr e10) (cadr e11)))
                   )
                 (setq pt  (list (- (car e10) lbz_offset) (cadr e10))
                       e50 (/ pi 2)
                 )
                 (setq pt  (list (car e10) (+ (cadr e10) lbz_offset))
                       e50 0.0
                 )
               )
               (if (or (= (car e10) (car e11))
                       (= (cadr e10) (cadr e11))
                   )
                 (entmake (list        '(0 . "DIMENSION")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbDimension")
                                (cons 10 pt)
                                '(70 . 32)
                                '(1 . "")
                                (cons 3 (getvar "DIMSTYLE"))
                                '(100 . "AcDbAlignedDimension")
                                (cons 13 e10)
                                (cons 14 e11)
                                (cons 50 e50)
                                '(100 . "AcDbRotatedDimension")
                          )
                 ) ;_绘制线性标注
                 (progn
                   (setq ang (+ (/ pi 2) (angle e10 e11))
                         ang (rem ang pi)
                         pt  (polar e10 ang lbz_offset)
                   )
                   (entmake (list '(0 . "DIMENSION")
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbDimension")
                                  (cons 10 pt)
                                  '(70 . 33)
                                  '(1 . "")
                                  (cons 3 (getvar "DIMSTYLE"))
                                  '(100 . "AcDbAlignedDimension")
                                  (cons 13 e10)
                                  (cons 14 e11)
                            )
                   )
                 ) ;_绘制对齐标注
               )
             )
           )
          )
          ((and (= e0 "ARC")(equal ltype e6)(equal col e62)) ;_判断与源物体是否同颜色,同线型
           (setq e10 (cdr (assoc 10 ent))
                 e40 (cdr (assoc 40 ent))
                 pt1 (polar
                       e10
                       (/ (+ (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
                          2
                       )
                       (+ e40 LBZ_OFFSET)
                     )
           )
           (setq ob  (vlax-ename->vla-object na)
                 len (vlax-curve-getDistAtParam
                       ob
                       (vlax-curve-getEndParam ob)
                     )
                 e10 (vlax-curve-getStartPoint ob)
                 e11 (vlax-curve-getEndPoint ob)
           )
           (command "_.DIMARC"
                    (list na e10)
                    pt1
           ) ;_绘制弧线标注
          )
        )
      )
    )
  )
  (setvar "OSMODE" oldos)
  (command "_.UNDO" "E")
  (setvar "CMDECHO" 1)
  (princ)
).
回复

使用道具 举报

 楼主| 发表于 2012-5-23 12:29:23 | 显示全部楼层
hb198075 发表于 2012-5-23 10:49
源码已经交给楼主了,由楼主来决定是否放出来吧~

在次感谢HB198075的帮忙,遗憾今天不能给加分。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-22 23:32 , Processed in 0.250079 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表