请选择 进入手机版 | 继续访问电脑版
天气与日历 切换到窄版

 找回密码
 立即注册
中国膜结构网
十大进口膜材评选 十大国产膜材评选 十大膜结构设计评选 十大膜结构公司评选
查看: 101|回复: 0

[源码] 相同文字连线如何加入属性块文字

[复制链接]
  • TA的每日心情
    开心
    昨天 09:47
  • 签到天数: 70 天

    [LV.6]常住居民II

    1370

    主题

    167

    回帖

    214748万

    积分

    管理员

    积分
    2147483647
    发表于 2024-2-20 19:47:26 | 显示全部楼层 |阅读模式

    (defun c:tt (/ *ent2obj* entbox get-dxf getmidpo olayer oldliness po px ss ss2list sslst str str2 ttent tylx)
      (setq *ent2obj*     vlax-Ename->Vla-Object)
      ;;单个物体的最小(正交)包围框
      (defun entbox ( ent / ll ur )
        (vla-getboundingbox (*ent2obj* ent) 'll 'ur)
        (mapcar 'vlax-safearray->list (list ll ur))
      )
      ;;求两点中点
      (defun getmidpo( pts / P1 P2 X Y )
        (setq p1 (car pts) p2 (cadr pts))
        (if (= (length p1) (length p2))
          nil
          (setq p1 (list (car p1) (cadr p1))
            p2 (list (car p2) (cadr p2))
          )
        )
        (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
      )
      ;;选择集转为图元列表
      (defun ss2list( ss )
        (reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
      )
      (defun get-dxf(en n)
        (if (not (listp en)) (setq en (entget en)))
        (cdr (assoc n en))
      )
      (setq olayer (getvar "clayer"))
      (command "layer" "m" "f_temp_文字连线" "c" "6" "" "")
      (setvar "cmdecho" 0)
      (if (setq ss (ssget ":e:s" '(
                                    (-4 . "<OR")
                                    (-4 . "<AND")(0 . "TEXT")(-4 . "AND>")
                                    (-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>")
                                    (-4 . "OR>")
                                  )
                   )
          )
        (progn
          (setq ttent (ssname ss 0))
          (setq tylx (get-dxf ttent 0))
          (cond
            ((= tylx "TEXT")
              (setq str (cdr (assoc 1 (entget ttent))))
            )
            ((= tylx "INSERT")
              (setq str (car (mapcar '(lambda (x) (vla-get-textstring x)) (vlax-invoke (vlax-ename->vla-object ttent) "getattributes"))))
            )
          )
          (setq po (getmidpo (entbox ttent)))
          (setq ss (ssget "x" (list
                                '(-4 . "<OR")
                                '(-4 . "<AND")'(0 . "TEXT")(cons 1 str)'(-4 . "AND>")
                                '(-4 . "<AND")'(0 . "INSERT")'(66 . 1)'(-4 . "AND>")
                                '(-4 . "OR>")
                              )
                   )
          )
          (setq sslst '())
          (foreach ty (ss2list ss)
            (setq tylx (get-dxf ty 0))
            (if (= tylx "INSERT")
              (progn
                (setq str2 (car (mapcar '(lambda (x) (vla-get-textstring x)) (vlax-invoke (vlax-ename->vla-object ty) "getattributes"))))
                (if (/= str str2)
                  (ssdel ty ss)
                )
              )
            )
          )
          (if (< 1 (sslength ss))
            (progn
              (setq oldliness (ssget "x" '((0 . "line")(8 . "f_temp_文字连线"))))
              (if oldliness (command "erase" oldliness ""))
              (setq ss (vl-remove ttent (ss2list ss)))
              (foreach x ss
                (setq px (getmidpo (entbox x)))
                (command "line" "non" po "non" px "")
              )
            )
            (command "change" ttent "" "p" "co" "2" "")
          )
        )
      )
      (setvar "clayer" olayer)
      (princ)
    )

     

     

     

     

    [源码] 相同文字连线如何加入属性块文字
    中国膜结构网打造全中国最好的膜结构综合平台 ,统一协调膜结构设计,膜结构施工,膜材采购,膜材定制,膜结构预算全方位服务。 中国空间膜结构协会合作单位。
    您需要登录后才可以回帖 登录 | 立即注册

    本版积分规则

    QQ|Archiver|手机版|中国膜结构网_中国空间膜结构协会

    GMT+8, 2024-4-20 11:04 , Processed in 0.059925 second(s), 21 queries .

    Powered by Discuz! X3.5

    © 2001-2024 Discuz! Team.

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