请高手相助！批量选择梁标注，将梁标注生成如下表格

664571221

请高手相助！批量选择梁标注，将梁标注生成如下表格

bluefcc1

初步完成，直接在cad裡面生成表格。
(defun c:aa(/ e11 e1 sn1 sn3 sn5 lst str)
(vl-load-com)
(setvar "CMDECHO" 0)
(command "osnap" "off")
(setvar "DIMZIN" 0)
     (setq ssss (ssadd))
     (setq t0 (rtos (getvar "cdate") 2 8))
     ;-----------------------------------
     (defun myerr(m)
       (if m (princ (strcat "\n ***ERROR: " m)))
       (if (>= (sslength ssss) 1)
        (progn
          (command "erase" ssss "")
        );end progn
       )
  

       (resosmode)                  ; 取回 OSMODE 狀態   
       (redraw)
       (setq *error* olderr)   
       (princ)
     )
     (setq olderr *error* *error* myerr)
    ;;----------------------------------
            (if (not (tblsearch "layer" "表格"))
                (command "layer" "n" "表格" "c" "4" "" "")
            )

            ;;命令回顯  
            (setvar "CMDECHO" 0)
            (command "undo" "be")
            ;;捕捉設置   
            (setq osmode_old (getvar "OSMODE"))
          
            ;;參數設置
                    (setq 內框顏色 1
                          文字顏色 2
                          外框顏色 3
                          座標精度 3
                    )
                    (setq 表格_高度 200.0
                          表格_寬度1 800.0
                          表格_寬度2 1200.0
                          表格_寬度3 1200.0
                          表頭字高 100.0
                          表中字高 100.0
                    )

     (graphscr)
     (setq oce (getvar "cmdecho"))
     (setvar "cmdecho" 0)
     (setvar "PICKBOX" 6)
     (princ "\n")      

       (setq b '3)   
            ;;繪製表頭
            (setvar "clayer" "表格")
            (initget "G g")

           ;;;;-------------------------------------------------------------------  
            (setq pt0 (getpoint "\n請指定表格繪製位置，或者 [改變參數(G)]:"))       
            (if        (or (= pt0 "G") (= pt0 "g"))
                (progn
                    (sz)          
                    (setq pt0 (getpoint "\n請指定表格繪製位置:"))
                )
            )
            (setq pt0_x        (car pt0)
                  pt0_y        (cadr pt0)
            )
            (SETQ PT1 (polar PT0 0 表格_寬度3)
                  PT3 (polar PT1 0 表格_寬度3)
                  PT5 (polar PT3 0 表格_寬度3)
                  PT7 (polar PT5 0 表格_寬度3)
                  PT71 (polar PT7 0 表格_寬度3)
                  PT72 (polar PT71 0 表格_寬度3)
                  PT2 (polar PT1 (* -0.5 PI) 表格_高度)
                  PT4 (polar PT3 (* -0.5 PI) 表格_高度)
                  PT6 (polar PT5 (* -0.5 PI) 表格_高度)
                  PT8 (polar PT7 (* -0.5 PI) 表格_高度)
                  PT9 (polar PT0 (* -0.5 PI) 表格_高度)
                  PT73 (polar PT71 (* -0.5 PI) 表格_高度)
                  PT74 (polar PT72 (* -0.5 PI) 表格_高度)
            )
            (COMMAND "color" 內框顏色)
            (COMMAND "PLINE" PT0 PT72 "")
            (ssadd (entlast) ssss)
            (COMMAND "PLINE" PT0 PT9 PT2 PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 PT8 PT73 PT71 PT73 PT74 PT72 "")
            (ssadd (entlast) ssss)
            (SETQ ZBS1 (entlast))
            (SETQ PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0))
                  PT10 (polar PT10 0 (/ 表格_寬度3 2.0))
            )
            (COMMAND "color" 文字顏色)

        (setq k 1)
        (repeat 6
          (COMMAND "TEXT" "J" "MC" PT10 表頭字高 0.0 (strcat "資料" (itoa k)))
          (ssadd (entlast) ssss)
          (SETQ PT10 (polar PT10 0 表格_寬度3))
          (setq k (+ k 1))
        )

           (setq c (getdist "設定點位標示大小(半徑大小)= \n"))
           (rep)

       (princ)
)

(defun rep ( / lst str e11 e1 sn1 e2 pt02_1 pt02 sn4 sn3 i j k)
            (setq str "")
   
            (while  (setq e11 (entsel "\n選取<左鍵>，結束<右鍵>:"))
               (/= (cdr (assoc '0 (entget (car e11)))) "TEXT")
               (setq e1 (entget (car e11)))            
               (setq sn1 (cdr (assoc '1 e1)))
               (setq e2 (entget (car e11)))
               (setq pt02_1 (assoc '10 e2))   ;讀取標定點座標(插入點)  
               (setq pt02 (cdr pt02_1))
               (COMMAND "color" 6)
               (command ".circle" pt02 c)
               (princ sn1)
               (setq str (strcat str sn1 " "))
            )
            (COMMAND "color" 文字顏色)
        ;  (princ (strcat "\n" str))
     ;-------------------------------
      (setq i 1)
      (setq sn3 "")
      (repeat (strlen str)            
              (cond
                  ((= (substr str i 1) ";")  (setq sn4 " "))
                  (t (setq sn4 (substr str i 1)))
              );end cond
             (setq sn3 (strcat sn3 sn4))
             (setq i (+ i 1))
      )
     ;----------------------------
        ;  (princ (strcat "\n" sn3))

     ;-------------------------------
      (setq j 1)
      (setq i 1)
      (repeat (strlen sn3)            
              (if (= (substr sn3 i 1) " ")
                (progn
                 (setq str2 (substr sn3 j (- i j)))                        
                 (setq lst (cons str2 lst))
                 (setq j (+ i 1))
                );end prong
              )
             (setq i (+ i 1))
       )
    (setq k 0)     
    (setq lst (reverse lst))
          (COMMAND "color" 文字顏色)
          (COMMAND "COPY" ZBS1 "" pt0 pt9)
          (ssadd (entlast) ssss)
          (SETQ ZBS1 (entlast))
          (setq pt0 pt9)
          (setq PT9 (polar PT0 (* -0.5 PI) 表格_高度))
          (SETQ PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0)))
          (SETQ PT10 (polar PT10 0 (/ 表格_寬度3 2.0)))  
        (repeat 5
          (COMMAND "TEXT" "J" "MC" PT10 表頭字高 0.0 (nth k lst))
          (ssadd (entlast) ssss)
          (SETQ PT10 (polar PT10 0 表格_寬度3))
          (setq k (+ k 1))
        )
          (princ "\n<結束>左鍵> / <繼續>右鍵> :")
            (setq TEST t)
            (while TEST
               (setq TMP (grread t 7 1))
               (cond
                  ((= (car TMP) 3)
                       (setq TEST NIL)
               )
                  ((= (car TMP) 25)
                       (rep)
                       (setq TEST NIL)
                  )
              );end cond
           )

)

bluefcc1

664571221 发表于 2018-7-17 12:17
大神你好，箭头处的好像不能提取，就是最后的那个文字，还有是否可以改成框选，提取后的吧文字变成红色

;;參考荒野孤行 【源碼】將單行/多行文字合併http://bbs.mjtd.com/forum.php?mod=viewthread&tid=171203&highlight=%B6%E0%D0%D0%CE%C4%D7%D6%BA%CF%B2%A2
可框選，文字提取後顏色變成紅色

664571221

bluefcc1 发表于 2018-7-17 19:36
;;參考荒野孤行 【源碼】將單行/多行文字合併http://bbs.mjtd.com/forum.php?mod=viewthread&tid=171203& ...

你好大神 貌似运行不起来，运行后只出现一条红线

524917100

你这个得定制，一般人不会这样弄的

664571221

524917100 发表于 2018-7-6 19:18
你这个得定制，一般人不会这样弄的

能不能帮忙弄下呀

bluefcc1

批量選擇樑標註，這有dwg檔？

664571221

bluefcc1 发表于 2018-7-14 10:03
批量選擇樑標註，這有dwg檔？

你好大神，图纸已经上传，麻烦看下

bluefcc1

傳錯檔案。。

bluefcc1

不知道是不是你要的?

bluefcc1

不知道是不是你要的?

tigcat

bluefcc1 发表于 2018-7-15 21:47
不知道是不是你要的?

好厉害啊,不过一般不需要这么复杂的功能吧