请大神优化批量修改集中标注行距的程序

tumu2008323 · 发表于 2016-2-1 13:25

本帖最后由 tumu2008323 于 2016-2-1 13:27 编辑

我改写了一个批量修改行距的插件，由于刚开始学，写的比较粗糙，比较啰嗦，目前还有几个bug，文字超出引线时，不能修改引线长度，还有一

项三种不能修改行距，请大神帮忙优化

;;; ====================================
;;; 天若有情007 tumu2008323@163.com
;;; 其中，引用了Lee Mac的修改行距以及最小包围圈为子程序
;;;
;;; ===============================
;;; 改集中标注行距，行距默认为1.2
;;; 命令：ghj
;;; by 天若有情007 2016/02/01 V1.0
;;;
;;;
(defun c:ghj(/ ss ssl i j en enl enl_data en_data ptj dd ss_hj pt10 pt11 en_brh pthj1 pthj3 ptbrh1 ptbrh3)
(ycz_StoreSysVar)
(ycz_ChangeSysVar)
(command "undo" "be")
(setq jzbz_layer "S-BEAMCD-X-ANNO,S-BEAMCD-Y-ANNO");集中标注图层
;(setq LAYER_NEW "S-COMM-ELV")
(prompt "\n<<批量选择集中标注:>>")
(setq ss (ssget (list (cons 0 "TEXT") (cons 8 jzbz_layer))));集中标注
(prompt "\n<<批量选择引线:>>")
(setq ssl (ssget (list (cons 0 "LINE") (cons 8 jzbz_layer)));引线
i 0
ss_hj (ssadd)
)
(if ssl
(repeat (sslength ssl)
(setq enl (ssname ssl i)
j 0
enl_data (entget enl)
pt10 (cdr (assoc 10 enl_data))
pt11 (cdr (assoc 11 enl_data))
)
;(setq ss2 ss)
(repeat (sslength ss);文字循环查找
(setq en (ssname ss j)
en_data (entget en)
)
(ycz_dist);求文字到引线的距离
(if ptj;如果交点存在
(progn
(if (< dd 200)
(progn
(setq ss_hj (ssadd en ss_hj)
ss (ssdel en ss);如果已经循环过，则从ss中删除，但是好像有问题
j (1- j)
)
)
)
)
)
(setq j (1+ j))
)
(if ss_hj
(Lee_hj)
)
(if ss_hj
(progn
(LEE_BRH)
(setq en_brh (entlast))
;(ycz_rect en_brh)
(setq pthj1 (vlax-curve-getclosestpointto en_brh pt10)
pthj3 (vlax-curve-getclosestpointto en_brh pt11)
ptbrh1 (vlax-curve-getclosestpointto enl pthj1)
ptbrh3 (vlax-curve-getclosestpointto enl pthj3)
dd1 (distance pt10 pthj1)
dd3 (distance pt11 pthj3)
)
(entdel en_brh)
(if(< dd1 dd3)
(progn
(setq enl_data (subst (cons 10 ptbrh1) (assoc 10 enl_data) enl_data))
(entmod enl_data)
)
(progn
(setq enl_data (subst (cons 11 ptbrh3) (assoc 11 enl_data) enl_data))
(entmod enl_data)
)
)
)
)
(setq i (1+ i))
(setq ss_hj (ssadd))
)
)
(command "undo" "e")
(ycz_RestoreSysVar)
(prin1)
)
(defun ycz_StoreSysVar()
(setq vcmde (getvar "cmdecho")) ;普通命令的提示
(setq vblip (getvar "blipmode")) ;光标痕迹
(setq vclay (getvar "CLAYER")) ;图层
(setq vosmo (getvar "osmode")) ;捕捉模式
(setq vplwd (getvar "plinewid")) ;pl宽度
(setq Vlupr (getvar "luprec")) ;长度精度
(setq vlayer (getvar "clayer")) ;图层
(prin1)
)
(defun ycz_ChangeSysVar()
(setvar "cmdecho" 0);关闭命令响应
(setvar "osmode" 0);关闭捕捉
(command "ortho" 0);关闭正交
(prin1)
)
;还原系统变量
(defun ycz_RestoreSysVar()
(setvar "cmdecho" vcmde)
(setvar "blipmode" vblip)
(setvar "CLAYER" vclay)
(setvar "osmode" vosmo)
(setvar "plinewid" vplwd)
(setvar "luprec" Vlupr)
(command "ortho" 1)
(setvar "clayer" vlayer)
(prin1)
)
;求文字到直线距离
(defun ycz_dist ()
(command "ucs" "e" en)
(setq box (textbox en_data)
p1 (car box)
p1 (trans p1 1 0)
)
(command "ucs" "")
(setq ptj (vlax-curve-getclosestpointto enl p1))
(setq dd (distance p1 ptj))
(prin1)
)
;Lee的改行距程序
(defun Lee_hj ( / *error* bpt enx inc ins lst sel spf vec )
(setq spf 1.2) ;; 行距因子
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq inc (sslength ss_hj)
enx (entget (ssname ss_hj (1- inc)))
spf (polar '(0.0 0.0) (+ (cdr (assoc 50 enx)) (/ pi 2.0)) (* (cdr (assoc 40 enx)) spf))
vec (trans spf (trans '(0.0 0.0 1.0) 1 0 t) 0)
)
(repeat inc
(setq lst (cons (entget (ssname ss_hj (setq inc (1- inc)))) lst)
ins (cons (caddr (trans (aligntext:gettextinsertion (car lst)) (cdr (assoc -1 (car lst))) vec)) ins)
)
)
(setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>))
bpt (aligntext:gettextinsertion (car lst))
)
(LM:startundo (LM:acdoc))
(foreach itm (cdr lst)
(aligntext:puttextinsertion (setq bpt (mapcar '- bpt spf)) itm)
)
(LM:endundo (LM:acdoc))
(princ)
)
(defun aligntext:getdxfkey ( enx )
(if
(and
(zerop (cdr (assoc 72 enx)))
(zerop (cdr (assoc 73 enx)))
)
10 11
)
)
(defun aligntext:gettextinsertion ( enx )
(cdr (assoc (aligntext:getdxfkey enx) enx))
)
(defun aligntext:puttextinsertion ( ins enx )
( (lambda ( key )
(if (entmod (subst (cons key ins) (assoc key enx) enx))
(entupd (cdr (assoc -1 enx)))
)
)
(aligntext:getdxfkey enx)
)
)
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
;;;Lee的最小包容盒
(defun LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb )
(if ss
(progn
(setq bb
(LM:ListBoundingBox
(repeat (setq i (sslength ss))
(setq l (cons (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))) l))
)
)
)
(setq pr (* pr pi)
cn (apply 'mapcar (cons (function (lambda ( a b ) (/ (+ a b) 2.0))) bb))
cv (vlax-3D-point cn)
bm (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb)))
mb (cons 0.0 bb)
an 0
)
(while (< (setq an (+ an pr)) pi)
(foreach x l (vla-rotate x cv pr))
(setq bb (LM:ListBoundingBox l)
ba (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb)))
)
(if (< ba bm) (setq bm ba mb (cons an bb)))
)
(foreach x l (vla-delete x))
(LM:RotatePointsByMatrix
(mapcar
(function
(lambda ( a )
(mapcar (function (lambda ( b ) ((eval b) (cdr mb)))) a)
)
)
'((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
)
cn (- (car mb))
)
)
)
)
(defun LM:ListBoundingBox ( lst / l1 l2 ll ur )
(foreach obj lst
(vla-getboundingbox obj 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar
(function (lambda ( a b ) (apply 'mapcar (cons a b))))
'(min max) (list l1 l2)
)
)
(defun LM:RotatePointsByMatrix ( l p a / m )
(setq m
(list
(list (cos a) (sin (- a)) 0.0)
(list (sin a) (cos a) 0.0)
(list 0.0 0.0 1.0)
)
)
(setq p (mapcar '- p (mxv m p)))
(mapcar (function (lambda ( x ) (mapcar '+ (mxv m x) p))) l)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(defun LEE_BRH( / s )
;(princ "\n绘制最小包容盒:")
(if (setq s ss_hj)
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 1)
)
(mapcar '(lambda ( p ) (cons 10 p)) (LM:MinBoundingBox s 0.01))
)
)
)
(prin1)
)
(prompt "\n作者：天若有情007")
(prompt "\n<c:ghj>批量修改梁集中标注行距\n其中，引用了Lee Mac的修改行距以及最小包围圈为子程序")
(prin1)

;;;  ==================================== 
;;;  天若有情007 tumu2008323@163.com 
;;;  其中，引用了Lee Mac的修改行距以及最小包围圈为子程序 
;;;   
;;;  =============================== 
;;;  改集中标注行距，行距默认为1.2 
;;;  命令：ghj 
;;;  by 天若有情007 2016/02/01 V1.0 
;;;            
;;; 
 
(defun c:ghj(/ ss ssl i j en enl enl_data en_data ptj dd ss_hj pt10 pt11 en_brh pthj1 pthj3 ptbrh1 ptbrh3) 
  (ycz_StoreSysVar) 
  (ycz_ChangeSysVar) 
  (command "undo" "be") 
  (setq jzbz_layer "S-BEAMCD-X-ANNO,S-BEAMCD-Y-ANNO");集中标注图层 
  ;(setq LAYER_NEW "S-COMM-ELV") 
  (prompt "\n<<批量选择集中标注:>>")   
  (setq ss (ssget (list (cons 0 "TEXT") (cons 8 jzbz_layer))));集中标注 
  (prompt "\n<<批量选择引线:>>") 
  (setq ssl (ssget (list (cons 0 "LINE") (cons 8 jzbz_layer)));引线 
        i 0 
        ss_hj (ssadd)   
  ) 
  (if ssl 
    (repeat (sslength ssl) 
      (setq enl (ssname ssl i) 
            j 0 
            enl_data (entget enl) 
            pt10 (cdr (assoc 10 enl_data)) 
            pt11 (cdr (assoc 11 enl_data)) 
      )                     
       
      ;(setq ss2 ss) 
      (repeat (sslength ss);文字循环查找 
        (setq en (ssname ss j) 
              en_data (entget en) 
        )               
        (ycz_dist);求文字到引线的距离 
        (if ptj;如果交点存在 
          (progn 
            (if (< dd 200) 
              (progn 
                (setq ss_hj (ssadd en ss_hj) 
                      ss (ssdel en ss);如果已经循环过，则从ss中删除，但是好像有问题 
                      j (1- j) 
                ) 
              ) 
            ) 
          ) 
                   
        ) 
        (setq j (1+ j)) 
         
      ) 
      (if ss_hj 
        (Lee_hj) 
      ) 
      (if ss_hj 
        (progn 
          (LEE_BRH) 
          (setq en_brh (entlast)) 
          ;(ycz_rect en_brh) 
          (setq pthj1 (vlax-curve-getclosestpointto en_brh pt10) 
                pthj3 (vlax-curve-getclosestpointto en_brh pt11) 
                ptbrh1 (vlax-curve-getclosestpointto enl pthj1) 
                ptbrh3 (vlax-curve-getclosestpointto enl pthj3) 
                dd1 (distance pt10 pthj1) 
                dd3 (distance pt11 pthj3)             
          ) 
          (entdel en_brh) 
          (if(< dd1 dd3) 
            (progn                           
              (setq enl_data (subst (cons 10 ptbrh1) (assoc 10 enl_data) enl_data)) 
              (entmod enl_data)             
                            
            ) 
            (progn 
              (setq enl_data (subst (cons 11 ptbrh3) (assoc 11 enl_data) enl_data)) 
              (entmod enl_data)   
            ) 
          ) 
          
          
        ) 
         
      ) 
       
       
      (setq i (1+ i)) 
      (setq ss_hj (ssadd)) 
    ) 
  ) 
  (command "undo" "e") 
  (ycz_RestoreSysVar)   
  (prin1) 
) 
 
(defun ycz_StoreSysVar() 
  (setq vcmde (getvar "cmdecho"))  ;普通命令的提示 
  (setq vblip (getvar "blipmode")) ;光标痕迹 
  (setq vclay (getvar "CLAYER"))   ;图层 
  (setq vosmo (getvar "osmode"))   ;捕捉模式 
  (setq vplwd (getvar "plinewid")) ;pl宽度 
  (setq Vlupr (getvar "luprec"))   ;长度精度 
  (setq vlayer (getvar "clayer"))  ;图层 
  (prin1) 
) 
(defun ycz_ChangeSysVar() 
  (setvar "cmdecho" 0);关闭命令响应 
  (setvar "osmode" 0);关闭捕捉 
  (command "ortho" 0);关闭正交 
  (prin1) 
) 
;还原系统变量 
(defun ycz_RestoreSysVar() 
  (setvar "cmdecho" vcmde) 
  (setvar "blipmode" vblip) 
  (setvar "CLAYER" vclay) 
  (setvar "osmode" vosmo) 
  (setvar "plinewid" vplwd) 
  (setvar "luprec" Vlupr) 
  (command "ortho" 1) 
  (setvar "clayer" vlayer) 
  (prin1) 
) 
 
;求文字到直线距离 
(defun ycz_dist () 
  (command "ucs" "e" en) 
  (setq  box (textbox en_data) 
    p1  (car box) 
    p1 (trans p1 1 0)    
  ) 
  (command "ucs" "") 
  (setq ptj (vlax-curve-getclosestpointto enl p1)) 
  (setq dd (distance p1 ptj)) 
  (prin1) 
) 
 
;Lee的改行距程序 
(defun Lee_hj ( / *error* bpt enx inc ins lst sel spf vec ) 
 
    (setq spf 1.2) ;; 行距因子 
 
    (defun *error* ( msg ) 
        (LM:endundo (LM:acdoc)) 
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) 
            (princ (strcat "\nError: " msg)) 
        ) 
        (princ) 
    ) 
    (setq inc (sslength ss_hj) 
                  enx (entget (ssname ss_hj (1- inc))) 
                  spf (polar '(0.0 0.0) (+ (cdr (assoc 50 enx)) (/ pi 2.0)) (* (cdr (assoc 40 enx)) spf)) 
                  vec (trans spf (trans '(0.0 0.0 1.0) 1 0 t) 0) 
     ) 
            (repeat inc 
                (setq lst (cons (entget (ssname ss_hj (setq inc (1- inc)))) lst) 
                      ins (cons (caddr (trans (aligntext:gettextinsertion (car lst)) (cdr (assoc -1 (car lst))) vec)) ins) 
                ) 
            ) 
            (setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>)) 
                  bpt (aligntext:gettextinsertion (car lst)) 
            ) 
            (LM:startundo (LM:acdoc)) 
            (foreach itm (cdr lst) 
                (aligntext:puttextinsertion (setq bpt (mapcar '- bpt spf)) itm) 
            ) 
            (LM:endundo (LM:acdoc)) 
 
   
 
    (princ) 
) 
 
(defun aligntext:getdxfkey ( enx ) 
    (if 
        (and 
            (zerop (cdr (assoc 72 enx))) 
            (zerop (cdr (assoc 73 enx))) 
        ) 
        10 11 
    ) 
) 
 
(defun aligntext:gettextinsertion ( enx ) 
    (cdr (assoc (aligntext:getdxfkey enx) enx)) 
) 
 
(defun aligntext:puttextinsertion ( ins enx ) 
    (   (lambda ( key ) 
            (if (entmod (subst (cons key ins) (assoc key enx) enx)) 
                (entupd (cdr (assoc -1 enx))) 
            ) 
        ) 
        (aligntext:getdxfkey enx) 
    ) 
) 
 
(defun LM:startundo ( doc ) 
    (LM:endundo doc) 
    (vla-startundomark doc) 
) 
 
(defun LM:endundo ( doc ) 
    (while (= 8 (logand 8 (getvar 'undoctl))) 
        (vla-endundomark doc) 
    ) 
) 
 
;; Active Document  -  Lee Mac 
;; Returns the VLA Active Document Object 
 
(defun LM:acdoc nil 
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) 
    (LM:acdoc) 
) 
 
(vl-load-com) (princ) 
 
;;------------------------------------------------------------;; 
;;                         End of File                        ;; 
;;------------------------------------------------------------;; 
 
 
;;;Lee的最小包容盒 
(defun LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb ) 
  (if ss 
    (progn 
      (setq bb 
        (LM:ListBoundingBox 
          (repeat (setq i (sslength ss)) 
            (setq l (cons (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))) l)) 
          ) 
        ) 
      ) 
      (setq pr (* pr pi) 
            cn (apply 'mapcar (cons (function (lambda ( a b ) (/ (+ a b) 2.0))) bb)) 
            cv (vlax-3D-point cn) 
            bm (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb))) 
            mb (cons 0.0 bb) 
            an 0 
      ) 
      (while (< (setq an (+ an pr)) pi) 
        (foreach x l (vla-rotate x cv pr)) 
        (setq bb (LM:ListBoundingBox l) 
              ba (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb))) 
        ) 
        (if (< ba bm) (setq bm ba mb (cons an bb))) 
      ) 
      (foreach x l (vla-delete x)) 
      (LM:RotatePointsByMatrix 
        (mapcar 
          (function 
            (lambda ( a ) 
              (mapcar (function (lambda ( b ) ((eval b) (cdr mb)))) a) 
            ) 
          ) 
         '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr)) 
        ) 
        cn (- (car mb)) 
      ) 
    ) 
  ) 
) 
 
(defun LM:ListBoundingBox ( lst / l1 l2 ll ur ) 
  (foreach obj lst 
    (vla-getboundingbox obj 'll 'ur) 
    (setq l1 (cons (vlax-safearray->list ll) l1) 
          l2 (cons (vlax-safearray->list ur) l2) 
    ) 
  ) 
  (mapcar 
    (function (lambda ( a b ) (apply 'mapcar (cons a b)))) 
   '(min max) (list l1 l2) 
  ) 
) 
 
(defun LM:RotatePointsByMatrix ( l p a / m ) 
  (setq m 
    (list 
      (list (cos a) (sin (- a)) 0.0) 
      (list (sin a) (cos a)     0.0) 
      (list   0.0     0.0       1.0) 
    ) 
  ) 
  (setq p (mapcar '- p (mxv m p))) 
  (mapcar (function (lambda ( x ) (mapcar '+ (mxv m x) p))) l) 
) 
 
;; Matrix x Vector - Vladimir Nesterovsky 
;; Args: m - nxn matrix, v - vector in R^n 
 
(defun mxv ( m v ) 
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) 
) 
 
(defun LEE_BRH( / s ) 
  ;(princ "\n绘制最小包容盒:") 
  (if (setq s ss_hj) 
    (entmakex 
      (append 
        (list 
          (cons 0 "LWPOLYLINE") 
          (cons 100 "AcDbEntity") 
          (cons 100 "AcDbPolyline") 
          (cons 90 4) 
          (cons 70 1) 
        ) 
        (mapcar '(lambda ( p ) (cons 10 p)) (LM:MinBoundingBox s 0.01)) 
      ) 
    ) 
  ) 
  (prin1) 
) 
 
(prompt "\n作者：天若有情007") 
(prompt "\n<c:ghj>批量修改梁集中标注行距\n其中，引用了Lee Mac的修改行距以及最小包围圈为子程序") 
(prin1)

该贴已经同步到 tumu2008323的微博

依然小小鸟 · 发表于 2018-10-1 14:55

能多一个要求吗每行文字下面加条线

664571221 · 发表于 2018-10-3 11:25

你好集中标注要在什么图层上

bagu · 发表于 2020-4-7 09:32

不知效果如何

brbright · 发表于 2016-2-1 15:00

MSTEEL工具箱或萝卜的拉移随心已经写得很好了。

tumu2008323 · 发表于 2016-2-1 16:24

brbright 发表于 2016-2-1 15:00
MSTEEL工具箱或萝卜的拉移随心已经写得很好了。

位移随心的确是很好，但是位移随心不能批量修改啊，只能一个一个集中标注去拖，如果是那种大地库，就会要人命了啊

kozmosovia · 发表于 2016-2-1 17:03

本帖最后由 kozmosovia 于 2016-2-2 11:40 编辑

根据引线长度及其角度为条件过滤选择文本并相应排序，然后直接将文本按顺序转换成多重文本，调整对齐方式、行间距及与引线关系。
最后根据需要分解多重文本（个人建议不要分解）

PS:
个人感觉最好的方案应该是带多重属性（标注文字）的动态块（拉伸引线）或者直接使用MLEADER

ynhh · 发表于 2016-2-2 11:18

大师能写一个

批量修改标注文字和箭头大小的吗

kozmosovia · 发表于 2016-2-2 11:57

本帖最后由 kozmosovia 于 2016-2-2 12:16 编辑

没有测试的图纸，都是以0层为过滤条件

(Defun C:abc (/ _TEXT2MTEXT _GETPER _GETMTEXTBOX _PROCESSLINE SS I)
(Defun _Text2MText (obj / LL MT P0 P1 STR UR)
(setq obj (entget obj)
str (cdr (assoc 1 obj))
)
(entmake (list (cons 0 "MTEXT")
(cons 8 (cdr (assoc 8 obj)))
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 (cdr (assoc 10 obj)))
(cons 40 (cdr (assoc 40 obj)))
(cons 41 0)
(cons 71 1)
(cons 72 5)
(cons 1 str)
(cons 7 (cdr (assoc 7 obj)))
(list 11 1.0 0.0 0.0)
(cons 50 (cdr (assoc 50 obj)))
)
)
(setq obj (vlax-ename->vla-object (cdr (assoc -1 obj)))
mt (vlax-ename->vla-object (entlast))
)
(vla-getboundingbox obj 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
p1 (vlax-3d-point (list (car ll) (cadr ur)))
)
(vla-getboundingbox mt 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
p0 (vlax-3d-point (list (car ll) (cadr ur)))
)
(vla-move mt p0 p1)
mt
)
(Defun _GetPer (pt pt1 pt2 / norm PerPt)
(cond ((equal pt1 pt2) nil)
((or (equal pt pt1) (equal pt pt2)) pt)
(t
(setq norm (mapcar '- pt2 pt1)
pt1 (trans pt1 0 norm)
pt (trans pt 0 norm)
PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
)
)
)
)
(Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) off) (- (cadar l) off))
(list (+ (caadr l) off) (- (cadar l) off))
(list (+ (caadr l) off) (+ (cadadr l) off))
(list (- (caar l) off) (+ (cadadr l) off))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) off) (- (cadr o) off))
(list (+ (car o) w off) (- (cadr o) off))
(list (+ (car o) w off) (+ (cadr o) h off))
(list (- (car o) off) (+ (cadr o) h off))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(Defun _ProcessLine (obj / A10 A11 ANG B10 B11 BOX
DDD DIS I INS LEFT MT O10 O11
OB PER RIGHT SSET STR
)
(setq o10 (cdr (assoc 10 (entget obj)))
o11 (cdr (assoc 11 (entget obj)))
dis (* (distance o10 o11) 0.2)
ang (+ (* 0.5 pi) (angle o10 o11))
a10 (polar o10 ang dis)
a11 (polar o11 ang dis)
b10 (polar o10 ang (* dis -1.0))
b11 (polar o11 ang (* dis -1.0))
)
(if (setq i -1
sset (ssget "_cp"
(list a10 a11 b11 b10)
(list (cons 0 "text") (cons 8 "0"))
)
)
(progn
(repeat (sslength sset)
(setq obj (ssname sset (setq i (1+ i)))
box (_GetMTextBox obj 0.0)
)
(if (null (inters (car box) (last box) o10 o11 nil))
(progn
(setq per (_GetPer (car box) o10 o11)
ddd (list (distance per o10) obj)
)
(if (equal (angle per (car box))
(angle (car box) (cadr box))
0.01
)
(setq right (cons ddd right))
(setq left (cons ddd left))
)
)
)
)
(foreach abc (list left right)
(if abc
(progn
(setq abc (vl-sort abc
'(lambda (p1 p2) (< (car p1) (car p2)))
)
abc (mapcar 'last abc)
box (_GetMTextBox (car abc) 0.0) str nil
)
(if (equal (angle o10 o11)
(angle (car box) (last box))
0.01
)
(setq abc (reverse abc))
)
(foreach ob abc
(if (null str)
(setq str (cdr (assoc 1 (entget ob))))
(setq
str (strcat str "\\P" (cdr (assoc 1 (entget ob))))
)
)
)
(setq ob (_Text2MText (car abc))
box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
ins (last box)
per (_GetPer ins o10 o11)
ins (polar
per
(angle per ins)
(cdr
(assoc 40 (entget (vlax-vla-object->ename ob)))
)
)
)
(vla-put-textstring ob str)
(if
(not
(equal
(angle per ins)
(cdr (assoc 50 (entget (vlax-vla-object->ename ob)))
)
0.01
)
)
(vla-put-AttachmentPoint ob acAttachmentPointTopRight)
)
(vla-put-insertionpoint ob (vlax-3d-point ins))
(mapcar 'entdel abc)
)
)
)
)
)
)
(if (setq i -1
ss (ssget (list (cons 0 "line") (cons 8 "0")))
)
(repeat (sslength ss)
(_ProcessLine (ssname ss (setq i (1+ i))))
)
)
)

(Defun C:abc (/        _TEXT2MTEXT _GETPER _GETMTEXTBOX _PROCESSLINE SS I) 
  (Defun _Text2MText (obj / LL MT P0 P1 STR UR) 
    (setq obj (entget obj) 
          str (cdr (assoc 1 obj)) 
    ) 
    (entmake (list (cons 0 "MTEXT") 
                   (cons 8 (cdr (assoc 8 obj))) 
                   (cons 100 "AcDbEntity") 
                   (cons 100 "AcDbMText") 
                   (cons 10 (cdr (assoc 10 obj))) 
                   (cons 40 (cdr (assoc 40 obj))) 
                   (cons 41 0) 
                   (cons 71 1) 
                   (cons 72 5) 
                   (cons 1 str) 
                   (cons 7 (cdr (assoc 7 obj))) 
                   (list 11 1.0 0.0 0.0) 
                   (cons 50 (cdr (assoc 50 obj))) 
             ) 
    ) 
    (setq obj (vlax-ename->vla-object (cdr (assoc -1 obj))) 
          mt  (vlax-ename->vla-object (entlast)) 
    ) 
    (vla-getboundingbox obj 'll 'ur) 
    (setq ll (vlax-safearray->list ll) 
          ur (vlax-safearray->list ur) 
          p1 (vlax-3d-point (list (car ll) (cadr ur))) 
    ) 
    (vla-getboundingbox mt 'll 'ur) 
    (setq ll (vlax-safearray->list ll) 
          ur (vlax-safearray->list ur) 
          p0 (vlax-3d-point (list (car ll) (cadr ur))) 
    ) 
    (vla-move mt p0 p1) 
    mt 
  ) 
  (Defun _GetPer (pt pt1 pt2 / norm PerPt) 
    (cond ((equal pt1 pt2) nil) 
          ((or (equal pt pt1) (equal pt pt2)) pt) 
          (t 
           (setq norm  (mapcar '- pt2 pt1) 
                 pt1   (trans pt1 0 norm) 
                 pt    (trans pt 0 norm) 
                 PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0) 
           ) 
          ) 
    ) 
  ) 
  (Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W) 
    (Defun mxv (m v) 
      (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
    ) 
    (setq enx (entget obj)) 
    (if        (null off) 
      (setq off 0.0) 
    ) 
    (if 
      (setq l 
             (cond 
               ((= "TEXT" (cdr (assoc 0 enx))) 
                (setq b        (cdr (assoc 10 enx)) 
                      r        (cdr (assoc 50 enx)) 
                      l        (textbox enx) 
                ) 
                (list 
                  (list (- (caar l) off) (- (cadar l) off)) 
                  (list (+ (caadr l) off) (- (cadar l) off)) 
                  (list (+ (caadr l) off) (+ (cadadr l) off)) 
                  (list (- (caar l) off) (+ (cadadr l) off)) 
                ) 
               ) 
               ((= "MTEXT" (cdr (assoc 0 enx))) 
                (setq n        (cdr (assoc 210 enx)) 
                      b        (trans (cdr (assoc 10 enx)) 0 n) 
                      r        (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n)) 
                      w        (cdr (assoc 42 enx)) 
                      h        (cdr (assoc 43 enx)) 
                      j        (cdr (assoc 71 enx)) 
                      o        (list 
                          (cond 
                            ((member j '(2 5 8)) (/ w -2.0)) 
                            ((member j '(3 6 9)) (- w)) 
                            (0.0) 
                          ) 
                          (cond 
                            ((member j '(1 2 3)) (- h)) 
                            ((member j '(4 5 6)) (/ h -2.0)) 
                            (0.0) 
                          ) 
                        ) 
                ) 
                (list 
                  (list (- (car o) off) (- (cadr o) off)) 
                  (list (+ (car o) w off) (- (cadr o) off)) 
                  (list (+ (car o) w off) (+ (cadr o) h off)) 
                  (list (- (car o) off) (+ (cadr o) h off)) 
                ) 
               ) 
             ) 
      ) 
       ((lambda        (m) 
          (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l) 
        ) 
         (list 
           (list (cos r) (sin (- r)) 0.0) 
           (list (sin r) (cos r) 0.0) 
           '(0.0 0.0 1.0) 
         ) 
       ) 
    ) 
  ) 
  (Defun _ProcessLine (obj   /           A10         A11   ANG   B10   B11         BOX 
                       DDD   DIS   I         INS   LEFT  MT           O10         O11 
                       OB    PER   RIGHT SSET  STR 
                      ) 
    (setq o10 (cdr (assoc 10 (entget obj))) 
          o11 (cdr (assoc 11 (entget obj))) 
          dis (* (distance o10 o11) 0.2) 
          ang (+ (* 0.5 pi) (angle o10 o11)) 
          a10 (polar o10 ang dis) 
          a11 (polar o11 ang dis) 
          b10 (polar o10 ang (* dis -1.0)) 
          b11 (polar o11 ang (* dis -1.0)) 
    ) 
    (if        (setq i           -1 
              sset (ssget "_cp" 
                          (list a10 a11 b11 b10) 
                          (list (cons 0 "text") (cons 8 "0")) 
                   ) 
        ) 
      (progn 
        (repeat        (sslength sset) 
          (setq        obj (ssname sset (setq i (1+ i))) 
                box (_GetMTextBox obj 0.0) 
          ) 
          (if (null (inters (car box) (last box) o10 o11 nil)) 
            (progn 
              (setq per        (_GetPer (car box) o10 o11) 
                    ddd        (list (distance per o10) obj) 
              ) 
              (if (equal (angle per (car box)) 
                         (angle (car box) (cadr box)) 
                         0.01 
                  ) 
                (setq right (cons ddd right)) 
                (setq left (cons ddd left)) 
              ) 
            ) 
          ) 
        ) 
        (foreach abc (list left right) 
          (if abc 
            (progn 
              (setq abc        (vl-sort abc 
                                 '(lambda (p1 p2) (< (car p1) (car p2))) 
                        ) 
                    abc        (mapcar 'last abc) 
                    box        (_GetMTextBox (car abc) 0.0) str nil 
              ) 
              (if (equal (angle o10 o11) 
                         (angle (car box) (last box)) 
                         0.01 
                  ) 
                (setq abc (reverse abc)) 
              ) 
              (foreach ob abc 
                (if (null str) 
                  (setq str (cdr (assoc 1 (entget ob)))) 
                  (setq 
                    str        (strcat str "\\P" (cdr (assoc 1 (entget ob)))) 
                  ) 
                ) 
              ) 
              (setq ob        (_Text2MText (car abc)) 
                    box        (_GetMTextBox (vlax-vla-object->ename ob) 0.0) 
                    ins        (last box) 
                    per        (_GetPer ins o10 o11) 
                    ins        (polar 
                          per 
                          (angle per ins) 
                          (cdr 
                            (assoc 40 (entget (vlax-vla-object->ename ob))) 
                          ) 
                        ) 
              ) 
              (vla-put-textstring ob str) 
              (if 
                (not 
                  (equal 
                    (angle per ins) 
                    (cdr (assoc 50 (entget (vlax-vla-object->ename ob))) 
                    ) 
                    0.01 
                  ) 
                ) 
                 (vla-put-AttachmentPoint ob acAttachmentPointTopRight) 
              ) 
              (vla-put-insertionpoint ob (vlax-3d-point ins)) 
              (mapcar 'entdel abc) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if (setq i  -1 
            ss (ssget (list (cons 0 "line") (cons 8 "0"))) 
      ) 
    (repeat (sslength ss) 
      (_ProcessLine (ssname ss (setq i (1+ i)))) 
    ) 
  ) 
)

tumu2008323 · 发表于 2016-2-2 12:33

kozmosovia 发表于 2016-2-2 11:57
没有测试的图纸，都是以0层为过滤条件

多谢大神出手

，程序很棒

，但是有两个问题还没有找到原因，一个是原来的钢筋符号变成了%%153，而不显示钢筋符号，第二个是不能调整引线长度，希望大神方便可以修改一下

kozmosovia · 发表于 2016-2-2 13:31

本帖最后由 kozmosovia 于 2016-2-2 17:00 编辑

特殊钢筋符号这些MTEXT处理起来可能只能使用TTF替换，但是这样与他人的兼容可能会出现问题，因此估计只能再把MTEXT分解成TEXT。

引线头部削平了

(Defun C:abc2 (/ _TEXT2MTEXT _GETPER _GETMTEXTBOX
_PROCESSLINE _CHANGEALIGN _GETMID SS
I
)
(Defun _Text2MText (obj / LL MT P0 P1 STR UR)
(setq obj (entget obj)
str (cdr (assoc 1 obj))
)
(entmake (list (cons 0 "MTEXT")
(cons 8 (cdr (assoc 8 obj)))
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 (cdr (assoc 10 obj)))
(cons 40 (cdr (assoc 40 obj)))
(cons 41 0)
(cons 71 1)
(cons 72 5)
(cons 1 str)
(cons 7 (cdr (assoc 7 obj)))
(list 11 1.0 0.0 0.0)
(cons 50 (cdr (assoc 50 obj)))
)
)
(setq obj (cdr (assoc -1 obj))
p1 (_GetMTextBox obj)
p1 (vlax-3d-point (_GetMid (car p1)(caddr p1)))
mt (entlast)
p0 (_GetMTextBox mt)
p0 (vlax-3d-point (_GetMid (car p0)(caddr p0)))
mt (vlax-ename->vla-object mt)
)
(vla-move mt p0 p1)
mt
)
(Defun _GetPer (pt pt1 pt2 / norm PerPt)
(cond ((equal pt1 pt2) nil)
((or (equal pt pt1) (equal pt pt2)) pt)
(t
(setq norm (mapcar '- pt2 pt1)
pt1 (trans pt1 0 norm)
pt (trans pt 0 norm)
PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
)
)
)
)
(Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) off) (- (cadar l) off))
(list (+ (caadr l) off) (- (cadar l) off))
(list (+ (caadr l) off) (+ (cadadr l) off))
(list (- (caar l) off) (+ (cadadr l) off))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) off) (- (cadr o) off))
(list (+ (car o) w off) (- (cadr o) off))
(list (+ (car o) w off) (+ (cadr o) h off))
(list (- (car o) off) (+ (cadr o) h off))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(Defun _ProcessLine (obj / A10 A11 ALI ANG B10 B11
BOX DDD DIS EPT I INS LEFT LIN
O10 O11 OB PER RIGHT SPT SS SSET
STR THH
)
(setq o10 (cdr (assoc 10 (entget obj)))
o11 (cdr (assoc 11 (entget obj)))
dis (* (distance o10 o11) 0.2)
ang (+ (* 0.5 pi) (angle o10 o11))
a10 (polar o10 ang dis)
a11 (polar o11 ang dis)
b10 (polar o10 ang (* dis -1.0))
b11 (polar o11 ang (* dis -1.0))
lin (vlax-ename->vla-object obj)
)
(if (setq i -1
sset (ssget "_cp"
(list a10 a11 b11 b10)
(list (cons 0 "text") (cons 8 "0"))
)
)
(progn
(repeat (sslength sset)
(setq obj (ssname sset (setq i (1+ i)))
box (_GetMTextBox obj 0.0)
)
(if (null (inters (car box) (last box) o10 o11 nil))
(progn
(setq per (_GetPer (car box) o10 o11)
ddd (list (distance per o10) obj)
)
(if (equal (angle per (car box))
(angle (car box) (cadr box))
0.01
)
(setq right (cons ddd right))
(setq left (cons ddd left))
)
)
)
)
(foreach abc (list left right)
(if abc
(progn
(setq abc (vl-sort abc
'(lambda (p1 p2) (< (car p1) (car p2)))
)
abc (mapcar 'last abc)
box (_GetMTextBox (car abc) 0.0)
str nil
)
(if (equal (angle o10 o11)
(angle (car box) (last box))
0.01
)
(setq abc (reverse abc))
)
(foreach ob abc
(if (null str)
(setq str (cdr (assoc 5 (entget ob))))
(setq
str (strcat str "\\P" (cdr (assoc 5 (entget ob))))
)
)
)
(setq ob (_Text2MText (car abc))
box (vla-put-textstring ob str)
box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
ins (last box)
spt (_GetPer (last box) o10 o11)
thh (cdr
(assoc 40 (entget (vlax-vla-object->ename ob)))
)
ins (polar spt (angle spt (last box)) (* 0.5 thh))
)
(if
(not
(equal
(angle spt ins)
(cdr (assoc 50 (entget (vlax-vla-object->ename ob)))
)
0.01
)
)
(setq ali acAttachmentPointTopRight)
(setq ali acAttachmentPointTopLeft)
)
(vla-put-AttachmentPoint ob ali)
(vla-put-insertionpoint ob (vlax-3d-point ins))
(setq box (_GetMTextBox (vlax-vla-object->ename ob) 0.0)
spt (_GetPer (last box) o10 o11)
ept (_GetPer (car box) o10 o11)
mid (_GetMid spt ept)
ept (polar ept (angle mid ept) (* 0.2 thh))
spt (polar spt (angle mid spt) (* 0.2 thh))
)
(if (> (distance o10 mid) (distance o11 mid))
(setq mid o10)
(setq mid o11)
)
(if (equal (distance spt mid)
(+ (distance ept mid)
(distance spt ept)
)
0.01
)
(setq ept mid)
(setq spt mid)
)
(vla-put-startpoint lin (vlax-3d-point spt))
(vla-put-endpoint lin (vlax-3d-point ept))
(command "_.Explode" (vlax-vla-object->ename ob))
(setq i -1
ss (ssget "_p")
)
(repeat (sslength ss)
(if (setq ob (vlax-ename->vla-object
(ssname ss (setq i (1+ i)))
)
ob (_ChangeAlign ob ali)
abc (handent (vla-get-textstring ob))
)
(setq abc (vlax-ename->vla-object abc)
ob (vla-put-textstring ob (vla-get-textstring abc))
abc (vla-erase abc)
)
)
)
)
)
)
)
)
)
(Defun _GetMid (p1 p2)
(polar p1 (angle p1 p2) (* 0.5 (distance p1 p2)))
)
(Defun _ChangeAlign (vlo ali / BOX BOY)
(if (= ali acAttachmentPointTopRight)
(progn
(setq box (_GetMTextBox (vlax-vla-object->ename vlo) 0.0)
box (_GetMid (car box) (caddr box))
)
(vla-put-alignment vlo acAlignmentRight)
(setq boy (_GetMTextBox (vlax-vla-object->ename vlo) 0.0)
boy (_GetMid (car boy) (caddr boy))
)
(vla-move vlo (vlax-3d-point boy) (vlax-3d-point box))
)
)
vlo
)
(if (setq i -1
ss (ssget (list (cons 0 "line") (cons 8 "0")))
)
(repeat (sslength ss)
(_ProcessLine (ssname ss (setq i (1+ i))))
)
)
)

(Defun C:abc2 (/             _TEXT2MTEXT   _GETPER         _GETMTEXTBOX 
               _PROCESSLINE  _CHANGEALIGN  _GETMID         SS 
               I 
              ) 
  (Defun _Text2MText (obj / LL MT P0 P1 STR UR) 
    (setq obj (entget obj) 
          str (cdr (assoc 1 obj)) 
    ) 
    (entmake (list (cons 0 "MTEXT") 
                   (cons 8 (cdr (assoc 8 obj))) 
                   (cons 100 "AcDbEntity") 
                   (cons 100 "AcDbMText") 
                   (cons 10 (cdr (assoc 10 obj))) 
                   (cons 40 (cdr (assoc 40 obj))) 
                   (cons 41 0) 
                   (cons 71 1) 
                   (cons 72 5) 
                   (cons 1 str) 
                   (cons 7 (cdr (assoc 7 obj))) 
                   (list 11 1.0 0.0 0.0) 
                   (cons 50 (cdr (assoc 50 obj))) 
             ) 
    ) 
    (setq obj (cdr (assoc -1 obj)) 
          p1 (_GetMTextBox obj) 
          p1 (vlax-3d-point (_GetMid (car p1)(caddr p1))) 
          mt  (entlast) 
          p0 (_GetMTextBox mt) 
          p0 (vlax-3d-point (_GetMid (car p0)(caddr p0))) 
          mt (vlax-ename->vla-object mt) 
    ) 
    (vla-move mt p0 p1) 
    mt 
  ) 
  (Defun _GetPer (pt pt1 pt2 / norm PerPt) 
    (cond ((equal pt1 pt2) nil) 
          ((or (equal pt pt1) (equal pt pt2)) pt) 
          (t 
           (setq norm  (mapcar '- pt2 pt1) 
                 pt1   (trans pt1 0 norm) 
                 pt    (trans pt 0 norm) 
                 PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0) 
           ) 
          ) 
    ) 
  ) 
  (Defun _GetMTextBox (obj off / MXV B ENX H J L M N O P R W) 
    (Defun mxv (m v) 
      (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
    ) 
    (setq enx (entget obj)) 
    (if        (null off) 
      (setq off 0.0) 
    ) 
    (if 
      (setq l 
             (cond 
               ((= "TEXT" (cdr (assoc 0 enx))) 
                (setq b        (cdr (assoc 10 enx)) 
                      r        (cdr (assoc 50 enx)) 
                      l        (textbox enx) 
                ) 
                (list 
                  (list (- (caar l) off) (- (cadar l) off)) 
                  (list (+ (caadr l) off) (- (cadar l) off)) 
                  (list (+ (caadr l) off) (+ (cadadr l) off)) 
                  (list (- (caar l) off) (+ (cadadr l) off)) 
                ) 
               ) 
               ((= "MTEXT" (cdr (assoc 0 enx))) 
                (setq n        (cdr (assoc 210 enx)) 
                      b        (trans (cdr (assoc 10 enx)) 0 n) 
                      r        (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n)) 
                      w        (cdr (assoc 42 enx)) 
                      h        (cdr (assoc 43 enx)) 
                      j        (cdr (assoc 71 enx)) 
                      o        (list 
                          (cond 
                            ((member j '(2 5 8)) (/ w -2.0)) 
                            ((member j '(3 6 9)) (- w)) 
                            (0.0) 
                          ) 
                          (cond 
                            ((member j '(1 2 3)) (- h)) 
                            ((member j '(4 5 6)) (/ h -2.0)) 
                            (0.0) 
                          ) 
                        ) 
                ) 
                (list 
                  (list (- (car o) off) (- (cadr o) off)) 
                  (list (+ (car o) w off) (- (cadr o) off)) 
                  (list (+ (car o) w off) (+ (cadr o) h off)) 
                  (list (- (car o) off) (+ (cadr o) h off)) 
                ) 
               ) 
             ) 
      ) 
       ((lambda        (m) 
          (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l) 
        ) 
         (list 
           (list (cos r) (sin (- r)) 0.0) 
           (list (sin r) (cos r) 0.0) 
           '(0.0 0.0 1.0) 
         ) 
       ) 
    ) 
  ) 
  (Defun _ProcessLine (obj   /           A10         A11   ALI   ANG   B10         B11 
                       BOX   DDD   DIS         EPT   I     INS   LEFT         LIN 
                       O10   O11   OB         PER   RIGHT SPT   SS         SSET 
                       STR   THH 
                      ) 
    (setq o10 (cdr (assoc 10 (entget obj))) 
          o11 (cdr (assoc 11 (entget obj))) 
          dis (* (distance o10 o11) 0.2) 
          ang (+ (* 0.5 pi) (angle o10 o11)) 
          a10 (polar o10 ang dis) 
          a11 (polar o11 ang dis) 
          b10 (polar o10 ang (* dis -1.0)) 
          b11 (polar o11 ang (* dis -1.0)) 
          lin (vlax-ename->vla-object obj) 
    ) 
    (if        (setq i           -1 
              sset (ssget "_cp" 
                          (list a10 a11 b11 b10) 
                          (list (cons 0 "text") (cons 8 "0")) 
                   ) 
        ) 
      (progn 
        (repeat        (sslength sset) 
          (setq        obj (ssname sset (setq i (1+ i))) 
                box (_GetMTextBox obj 0.0) 
          ) 
          (if (null (inters (car box) (last box) o10 o11 nil)) 
            (progn 
              (setq per        (_GetPer (car box) o10 o11) 
                    ddd        (list (distance per o10) obj) 
              ) 
              (if (equal (angle per (car box)) 
                         (angle (car box) (cadr box)) 
                         0.01 
                  ) 
                (setq right (cons ddd right)) 
                (setq left (cons ddd left)) 
              ) 
            ) 
          ) 
        ) 
        (foreach abc (list left right) 
          (if abc 
            (progn 
              (setq abc        (vl-sort abc 
                                 '(lambda (p1 p2) (< (car p1) (car p2))) 
                        ) 
                    abc        (mapcar 'last abc) 
                    box        (_GetMTextBox (car abc) 0.0) 
                    str        nil 
              ) 
              (if (equal (angle o10 o11) 
                         (angle (car box) (last box)) 
                         0.01 
                  ) 
                (setq abc (reverse abc)) 
              ) 
              (foreach ob abc 
                (if (null str) 
                  (setq str (cdr (assoc 5 (entget ob)))) 
                  (setq 
                    str        (strcat str "\\P" (cdr (assoc 5 (entget ob)))) 
                  ) 
                ) 
              ) 
              (setq ob        (_Text2MText (car abc)) 
                    box        (vla-put-textstring ob str) 
                    box        (_GetMTextBox (vlax-vla-object->ename ob) 0.0) 
                    ins        (last box) 
                    spt        (_GetPer (last box) o10 o11) 
                    thh        (cdr 
                          (assoc 40 (entget (vlax-vla-object->ename ob))) 
                        ) 
                    ins        (polar spt (angle spt (last box)) (* 0.5 thh)) 
              ) 
              (if 
                (not 
                  (equal 
                    (angle spt ins) 
                    (cdr (assoc 50 (entget (vlax-vla-object->ename ob))) 
                    ) 
                    0.01 
                  ) 
                ) 
                 (setq ali acAttachmentPointTopRight) 
                 (setq ali acAttachmentPointTopLeft) 
              ) 
              (vla-put-AttachmentPoint ob ali) 
              (vla-put-insertionpoint ob (vlax-3d-point ins)) 
              (setq box        (_GetMTextBox (vlax-vla-object->ename ob) 0.0) 
                    spt        (_GetPer (last box) o10 o11) 
                    ept        (_GetPer (car box) o10 o11) 
                    mid        (_GetMid spt ept) 
                    ept        (polar ept (angle mid ept) (* 0.2 thh)) 
                    spt        (polar spt (angle mid spt) (* 0.2 thh)) 
              ) 
              (if (> (distance o10 mid) (distance o11 mid)) 
                (setq mid o10) 
                (setq mid o11) 
              ) 
              (if (equal (distance spt mid) 
                         (+ (distance ept mid) 
                            (distance spt ept) 
                         ) 
                         0.01 
                  ) 
                (setq ept mid) 
                (setq spt mid) 
              ) 
              (vla-put-startpoint lin (vlax-3d-point spt)) 
              (vla-put-endpoint lin (vlax-3d-point ept)) 
 
              (command "_.Explode" (vlax-vla-object->ename ob)) 
              (setq i  -1 
                    ss (ssget "_p") 
              ) 
              (repeat (sslength ss) 
                (if (setq ob  (vlax-ename->vla-object 
                                (ssname ss (setq i (1+ i))) 
                              ) 
                          ob  (_ChangeAlign ob ali) 
                          abc (handent (vla-get-textstring ob)) 
                    ) 
                  (setq        abc (vlax-ename->vla-object abc) 
                        ob  (vla-put-textstring ob (vla-get-textstring abc)) 
                        abc (vla-erase abc) 
                  ) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (Defun _GetMid (p1 p2) 
    (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))) 
  ) 
  (Defun _ChangeAlign (vlo ali / BOX BOY) 
    (if        (= ali acAttachmentPointTopRight) 
      (progn 
        (setq box (_GetMTextBox (vlax-vla-object->ename vlo) 0.0) 
              box (_GetMid (car box) (caddr box)) 
        ) 
        (vla-put-alignment vlo acAlignmentRight) 
        (setq boy (_GetMTextBox (vlax-vla-object->ename vlo) 0.0) 
              boy (_GetMid (car boy) (caddr boy)) 
        ) 
        (vla-move vlo (vlax-3d-point boy) (vlax-3d-point box)) 
      ) 
    ) 
    vlo 
  ) 
  (if (setq i  -1 
            ss (ssget (list (cons 0 "line") (cons 8 "0"))) 
      ) 
    (repeat (sslength ss) 
      (_ProcessLine (ssname ss (setq i (1+ i)))) 
    ) 
  ) 
)

adc · 发表于 2016-2-4 21:14

kozmosovia 发表于 2016-2-2 13:31
特殊钢筋符号这些MTEXT处理起来可能只能使用TTF替换，但是这样与他人的兼容可能会出现问题，因此估计只能再 ...

海盗曹 · 发表于 2016-2-6 00:08

结构佬必须顶

账号		自动登录	找回密码
密码			注册

[提问] 请大神优化批量修改集中标注行距的程序

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源