求块替换文字

品茗新秀

求块替换文字

鱼与熊掌

风流少年时 发表于 2015-8-11 20:43
要删除圆圈，得到钢筋线坐标算出长度，然后写字。看楼组的发帖数量感觉应该能完成啊。

你可以看他发的帖子,每一篇前面都有个求字.

风流少年时

要删除圆圈，得到钢筋线坐标算出长度，然后写字。看楼组的发帖数量感觉应该能完成啊。

tigcat

1. ;;liviu_dova@yahoo.com
   
2. ;;;https://forums.augi.com/showthre ... g-Text-With-A-Block
   
3. ;;;2020-10-10, 06:59 PM
   
4. ;;;LiDo
   
5. (vl-load-com)
   
6. (DEFUN C:tt1 (/ *error* $Name bName EgEnt ENT lsBlN)
   
7.   (defun *error* (s)
   
8.     (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
   
9.     (princ)
   
10.   ) ;;*error*
    
11. ;List of block names
    
12.   (vlax-for
    
13.      itm
    
14.     (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    
15.     (if (and
    
16.           (vlax-property-available-p itm "Name")
    
17.           (/= (substr (setq $Name (vla-get-name itm)) 1 1) "*")
    
18.         )
    
19.       (setq lsBlN (cons $Name lsBlN))
    
20.     )
    
21.   )
    
22.   (if lsBlN
    
23.     (progn
    
24.       (princ "\n选择替换的图块：")
    
25.       (setq ent (entsel))
    
26.       (setq vobj (Vlax-Ename->Vla-Object (car ent)))
    
27.       (setq bname (vla-get-name vobj))
    
28.       
    
29. ;;Choose the block
    
30. ;;;      (while (not bName)
    
31. ;;;        (setq bName (getstring T "\nEnter block name or [?]: "))
    
32. ;;;        (cond
    
33. ;;;          ( (= bName "?")
    
34. ;;;            (textscr)
    
35. ;;;            (prompt "\nDefined blocks:")
    
36. ;;;            (foreach el lsBlN (prompt (strcat "\n" el)))
    
37. ;;;            (prompt "\nClick or Press any key to continue...")
    
38. ;;;            (vl-catch-all-apply (function grread) (list nil 14 0))
    
39. ;;;            (setq bName (graphscr))
    
40. ;;;          )
    
41. ;;;          ( (= bName "")
    
42. ;;;            (setq bName nil)
    
43. ;;;          )
    
44. ;;;          ( (and bName  (not (vl-position (strcase bName) (mapcar (function strcase) lsBlN))))
    
45. ;;;            (setq bName (prompt (strcat "\nCould not find block name \"" bName "\".")))
    
46. ;;;          )
    
47. ;;;          (T nil)
    
48. ;;;        )
    
49. ;;;      )
    
50. ;;Choose the text and replace it with the choosed block.
    
51.       (while  (and  (setq ENT (car (entsel "\nSelect the text to be replaced: ")))
    
52.                     (= (cdr (assoc 0 (setq EgEnt (entget ENT)))) "TEXT")
    
53.               )
    
54.         (if (= (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 EgEnt))))))) 0) ;;Layer not locked
    
55.           (progn
    
56.             (entdel ENT)
    
57.             (entmake
    
58.               (list
    
59.                 (quote (0 . "INSERT"))
    
60.                 (quote (100 . "AcDbEntity"))
    
61.                 (cons 67  (cdr (assoc 67  EgEnt)))
    
62.                 (cons 410 (cdr (assoc 410 EgEnt)))
    
63.                 (cons 8   (cdr (assoc 8   EgEnt)))
    
64.                 (quote (100 . "AcDbBlockReference"))
    
65.                 (cons 2 bName)
    
66.                 (cons 10 (cdr (assoc 10 EgEnt)))
    
67.                 (cons 50 (cdr (assoc 50 EgEnt)))
    
68.               )
    
69.             )
    
70.           )
    
71.           (prompt "\nText is on a locked layer.")
    
72.         )
    
73.       )
    
74.     )
    
75.     (prompt "\nNo block definitions in the drawing.")
    
76.   )
    
77.   (princ)
    
78. ) ;;REP-TXBK

;;<a href="mailto:liviu_dova@yahoo.com">liviu_dova@yahoo.com</a><br /> ;;;<a href="https://forums.augi.com/showthread.php?175247-AutoCAD-Lisp-For-Replacing-Text-With-A-Block" target="_blank">https://forums.augi.com/showthre ... g-Text-With-A-Block</a><br /> ;;;2020-10-10, 06:59 PM<br /> ;;;LiDo<br /> (vl-load-com)<br /> (DEFUN C:tt1 (/ *error* $Name bName EgEnt ENT lsBlN)<br />   (defun *error* (s)<br />     (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))<br />     (princ)<br />   ) ;;*error*<br /> ;List of block names<br />   (vlax-for<br />      itm<br />     (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))<br />     (if (and<br />           (vlax-property-available-p itm "Name")<br />           (/= (substr (setq $Name (vla-get-name itm)) 1 1) "*")<br />         )<br />       (setq lsBlN (cons $Name lsBlN))<br />     )<br />   )<br />   (if lsBlN<br />     (progn<br />       (princ "\n选择替换的图块：")<br />       (setq ent (entsel))<br />       (setq vobj (Vlax-Ename->Vla-Object (car ent)))<br />       (setq bname (vla-get-name vobj))<br />       <br /> ;;Choose the block<br /> ;;;      (while (not bName)<br /> ;;;        (setq bName (getstring T "\nEnter block name or [?]: "))<br /> ;;;        (cond<br /> ;;;          ( (= bName "?")<br /> ;;;            (textscr)<br /> ;;;            (prompt "\nDefined blocks:")<br /> ;;;            (foreach el lsBlN (prompt (strcat "\n" el)))<br /> ;;;            (prompt "\nClick or Press any key to continue...")<br /> ;;;            (vl-catch-all-apply (function grread) (list nil 14 0))<br /> ;;;            (setq bName (graphscr))<br /> ;;;          )<br /> ;;;          ( (= bName "")<br /> ;;;            (setq bName nil)<br /> ;;;          )<br /> ;;;          ( (and bName  (not (vl-position (strcase bName) (mapcar (function strcase) lsBlN))))<br /> ;;;            (setq bName (prompt (strcat "\nCould not find block name \"" bName "\".")))<br /> ;;;          )<br /> ;;;          (T nil)<br /> ;;;        )<br /> ;;;      )<br /> ;;Choose the text and replace it with the choosed block.<br />       (while  (and  (setq ENT (car (entsel "\nSelect the text to be replaced: ")))<br />                     (= (cdr (assoc 0 (setq EgEnt (entget ENT)))) "TEXT")<br />               )<br />         (if (= (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 EgEnt))))))) 0) ;;Layer not locked<br />           (progn<br />             (entdel ENT)<br />             (entmake<br />               (list<br />                 (quote (0 . "INSERT"))<br />                 (quote (100 . "AcDbEntity"))<br />                 (cons 67  (cdr (assoc 67  EgEnt)))<br />                 (cons 410 (cdr (assoc 410 EgEnt)))<br />                 (cons 8   (cdr (assoc 8   EgEnt)))<br />                 (quote (100 . "AcDbBlockReference"))<br />                 (cons 2 bName)<br />                 (cons 10 (cdr (assoc 10 EgEnt)))<br />                 (cons 50 (cdr (assoc 50 EgEnt)))<br />               )<br />             )<br />           )<br />           (prompt "\nText is on a locked layer.")<br />         )<br />       )<br />     )<br />     (prompt "\nNo block definitions in the drawing.")<br />   )<br />   (princ)<br /> ) ;;REP-TXBK