各位大神帮我看下，就是这个拉线的程序，能不能再集中的点那里增加一个块名称和个数

664571221

各位大神帮我看下，就是这个拉线的程序，能不能再集中的点那里增加一个块名称和个数

(defun c:TKLX ( / e1 p bname ss n)
(setq e1 (entsel "\n选择指定块:"))
(if (and e1 (= (cdr (assoc 0 (setq ent (entget (car e1))))) "INSERT"))
  (if (setq p (getpoint "\n指定一点:")) (progn
   (setq bname (assoc 2 ent))
   (princ "\n选择块<回车全选>: ")
   (or (setq ss (ssget (list '(0 . "INSERT") bname)))
       (setq ss (ssget "X" (list '(0 . "INSERT") bname)))
   )
   (repeat (setq n (sslength ss))
    (entmake
     (list
      '(0 . "LINE")
       (cons 10 p)
       (cons 11 (cdr(assoc 10 (entget (ssname ss (setq n (1- n)))))))
     )
    )
   )
  ))
)
(princ)
)

Bao_lai

1. (defun c:TKLX ( / e1 p bname ss n)
   
2. (setq e1 (entsel "\n选择指定块:"))
   
3. (if (and e1 (= (cdr (assoc 0 (setq ent (entget (car e1))))) "INSERT"))
   
4.   (if (setq p (getpoint "\n指定一点:")) (progn
   
5.    (setq bname (assoc 2 ent))
   
6.    (princ "\n选择块<回车全选>: ")
   
7.    (or (setq ss (ssget (list '(0 . "INSERT") bname)))
   
8.        (setq ss (ssget "X" (list '(0 . "INSERT") bname)))
   
9.    )
   
10.    (repeat (setq n (sslength ss))
    
11.     (entmake
    
12.      (list
    
13.       '(0 . "LINE")
    
14.        (cons 10 p)
    
15.        (cons 11 (cdr(assoc 10 (entget (ssname ss (setq n (1- n)))))))
    
16.      )
    
17.     )
    
18.    )
    
19.   ))
    
20. )
    
21. ;(entmake (list '(0 . "TEXT") (cons 1 内容) (cons 10 坐标) (cons 40 字高)))
    
22. (entmake (list '(0 . "TEXT") (cons 1 (itoa (sslength ss))) (cons 10 p) (cons 40 100)))
    
23. (princ)
    
24. )
    

(defun c:TKLX ( / e1 p bname ss n)<br /> (setq e1 (entsel "\n选择指定块:"))<br /> (if (and e1 (= (cdr (assoc 0 (setq ent (entget (car e1))))) "INSERT"))<br />   (if (setq p (getpoint "\n指定一点:")) (progn<br />    (setq bname (assoc 2 ent))<br />    (princ "\n选择块<回车全选>: ")<br />    (or (setq ss (ssget (list '(0 . "INSERT") bname)))<br />        (setq ss (ssget "X" (list '(0 . "INSERT") bname)))<br />    )<br />    (repeat (setq n (sslength ss))<br />     (entmake<br />      (list<br />       '(0 . "LINE")<br />        (cons 10 p)<br />        (cons 11 (cdr(assoc 10 (entget (ssname ss (setq n (1- n)))))))<br />      )<br />     )<br />    )<br />   ))<br /> )<br /> ;(entmake (list '(0 . "TEXT") (cons 1 内容) (cons 10 坐标) (cons 40 字高)))<br /> (entmake (list '(0 . "TEXT") (cons 1 (itoa (sslength ss))) (cons 10 p) (cons 40 100)))<br /> (princ)<br /> )<br />

664571221

Bao_lai 发表于 2024-4-3 15:28

谢谢大神 快名称可否一起加了

Bao_lai

664571221 发表于 2024-4-3 15:38
谢谢大神 快名称可否一起加了

1. (entmake (list '(0 . "TEXT") (cons 1 (strcat "块名:" bname "  数量:" (itoa (sslength ss)))) (cons 10 p) (cons 40 100)))
   

(entmake (list '(0 . "TEXT") (cons 1 (strcat "块名:" bname "  数量:" (itoa (sslength ss)))) (cons 10 p) (cons 40 100)))<br />

664571221

Bao_lai 发表于 2024-4-3 16:06

谢谢大神..

paulpipi

感谢分享,好像有点问题

伊偭

不能显示图块名称

664571221

paulpipi 发表于 2024-4-5 15:34
感谢分享,好像有点问题

什么问题啊

664571221

Bao_lai 发表于 2024-4-3 16:06

大神楼下的说不能显示图块名，我还没使用你看下

664571221

664571221 发表于 2024-4-6 10:59
大神楼下的说不能显示图块名，我还没使用你看下

小星修改
(defun c:TKLX3 ( / e1 p bname ss n)
(setq e1 (entsel "\n选择指定块:"))
(if (and e1 (= (cdr (assoc 0 (setq ent (entget (car e1))))) "INSERT"))
  (if (setq p (getpoint "\n指定一点:")) (progn
   (setq bname (assoc 2 ent))
   (princ "\n选择块<回车全选>: ")
   (or (setq ss (ssget (list '(0 . "INSERT") bname)))
       (setq ss (ssget "X" (list '(0 . "INSERT") bname)))
   )
   (repeat (setq n (sslength ss))
    (entmake
     (list
      '(0 . "LINE")
       (cons 10 p)
       (cons 11 (cdr(assoc 10 (entget (ssname ss (setq n (1- n)))))))
     )
    )
   )
  ))
)
(entmake (list '(0 . "TEXT") (cons 1 (strcat "块名:" (cdr bname) "  数量:" (itoa (sslength ss)))) (cons 10 p) (cons 40 100)))
(princ)
)