[LISP函数]：添加普通文字到图块成为属性

mmmm · 发表于 2007-2-1 17:08:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

函数共三个变量：
1：图块实体[ENAME]
2：文本实体[ENANE/单个 PICKSET/多个]
3：转换成属性后是否删除文本实体[T/NIL]

返回值：新生成的图块名[ENAME]

(Defun vlobj-attach-attrib (blk atx erase / att bbb nxx tmp rtn)
(setq bbb blk
blk (entget bbb)
)
(if (not (assoc 66 blk))
(setq blk (append blk (list (cons 66 1))))
)
(setq nxx (list blk))
(if (and (entnext bbb)
(= (cdr (assoc 0 (entget (entnext bbb)))) "ATTRIB")
)
(while
(/= (cdr (assoc 0 (entget (setq bbb (entnext bbb)))))
"SEQEND"
)
(setq nxx (cons (entget bbb) nxx))
)
)
(if (= (type atx) 'ename)
(setq atx (ssadd atx))
)
(if (and (= (type atx) 'pickset)
(setq bbb -1)
)
(progn
(repeat (sslength atx)
(if (and (setq att (ssname atx (setq bbb (1+ bbb))))
(setq tmp (cdr (assoc 1 (entget att)))
(setq tmp (list
(cons 0 "ATTRIB")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 100 "AcDbAttribute")
(cons 1 tmp)
(cons 2 (substr tmp 1 10)) ;防止TAG太长
(cons 6 "ByBlock")
(cons 7 "STANDARD")
(cons 8 "0")
(list 10 0.0 0.0 0.0)
(list 11 0.0 0.0 0.0)
(cons 40 1.0)
(cons 41 1.0)
(cons 50 0.0)
(cons 51 0.0)
(cons 62 256)
(cons 70 0)
(cons 72 0)
(cons 73 0)
)
)
)
(progn
(foreach bbb '(7 8 10 11 40 41 50 51 72 73)
(setq
tmp (subst (cons bbb (cdr (assoc bbb (entget att))))
(assoc bbb tmp)
tmp
)
)
)
(setq nxx (cons tmp nxx))
)
)
)
(setq nxx (cons (list (cons 0 "SEQEND")
(cons 100 "AcDbEntity")
(cons 8 (cdr (assoc 8 blk)))
)
nxx
)
)
(mapcar 'entmake (reverse nxx))
(setq rtn (entlast))
(if (and erase
(setq bbb -1)
(entdel (cdr (assoc -1 blk)))
)
(repeat (sslength atx)
(entdel (ssname atx (setq bbb (1+ bbb))))
)
)
)
)
rtn
)

(Defun vlobj-attach-attrib (blk atx erase / att bbb nxx tmp rtn) 
  (setq        bbb blk 
        blk (entget bbb) 
  ) 
  (if (not (assoc 66 blk)) 
    (setq blk (append blk (list (cons 66 1)))) 
  ) 
  (setq nxx (list blk)) 
  (if (and (entnext bbb) 
           (= (cdr (assoc 0 (entget (entnext bbb)))) "ATTRIB") 
      ) 
    (while 
      (/= (cdr (assoc 0 (entget (setq bbb (entnext bbb))))) 
          "SEQEND" 
      ) 
       (setq nxx (cons (entget bbb) nxx)) 
    ) 
  ) 
  (if (= (type atx) 'ename) 
    (setq atx (ssadd atx)) 
  ) 
  (if (and (= (type atx) 'pickset) 
           (setq bbb -1) 
      ) 
    (progn       
      (repeat (sslength atx) 
        (if (and (setq att (ssname atx (setq bbb (1+ bbb)))) 
                 (setq tmp (cdr (assoc 1 (entget att)))   
                 (setq tmp (list 
                             (cons 0 "ATTRIB") 
                             (cons 100 "AcDbEntity") 
                             (cons 100 "AcDbText") 
                             (cons 100 "AcDbAttribute") 
                             (cons 1 tmp) 
                             (cons 2 (substr tmp 1 10)) ;防止TAG太长 
                             (cons 6 "ByBlock") 
                             (cons 7 "STANDARD") 
                             (cons 8 "0") 
                             (list 10 0.0 0.0 0.0) 
                             (list 11 0.0 0.0 0.0) 
                             (cons 40 1.0) 
                             (cons 41 1.0) 
                             (cons 50 0.0) 
                             (cons 51 0.0) 
                             (cons 62 256) 
                             (cons 70 0) 
                             (cons 72 0) 
                             (cons 73 0) 
                           ) 
                 ) 
            ) 
          (progn 
            (foreach bbb '(7 8 10 11 40 41 50 51 72 73) 
              (setq 
                tmp (subst (cons bbb (cdr (assoc bbb (entget att)))) 
                           (assoc bbb tmp) 
                           tmp 
                    ) 
              ) 
            ) 
            (setq nxx (cons tmp nxx)) 
          ) 
        ) 
      ) 
      (setq nxx        (cons (list (cons 0 "SEQEND") 
                            (cons 100 "AcDbEntity") 
                            (cons 8 (cdr (assoc 8 blk))) 
                      ) 
                      nxx 
                ) 
      ) 
      (mapcar 'entmake (reverse nxx)) 
      (setq rtn (entlast)) 
      (if (and erase 
               (setq bbb -1) 
               (entdel (cdr (assoc -1 blk))) 
          ) 
        (repeat        (sslength atx) 
          (entdel (ssname atx (setq bbb (1+ bbb)))) 
        ) 
      ) 
    ) 
  ) 
  rtn 
)

jx2008 · 发表于 2007-2-1 20:22:21

怎么用法？三个变量是？

橄榄滋味 · 发表于 2007-2-2 10:59:01

中间漏了一个括号，下面是改好的，三个变量应该是：
blk--文字属性块图元名(car(entsel))
atx--单行文字，注意是单行文字不是多行文字(car(entsel))，只是搂主说的pickset多选不会用
erase--为空nil时保留原文字，否则删除

(Defun vlobj-attach-attrib (blk atx erase / att bbb nxx tmp rtn)
(setq bbb blk
blk (entget bbb)
)
(if (not (assoc 66 blk))
(setq blk (append blk (list (cons 66 1))))
)
(setq nxx (list blk))
(if (and (entnext bbb)
(= (cdr (assoc 0 (entget (entnext bbb)))) "ATTRIB")
)
(while
(/= (cdr (assoc 0 (entget (setq bbb (entnext bbb)))))
"SEQEND"
)
(setq nxx (cons (entget bbb) nxx))
)
)
(if (= (type atx) 'ename)
(setq atx (ssadd atx))
)
(if (and (= (type atx) 'pickset)
(setq bbb -1)
)
(progn
(repeat (sslength atx)
(if (and (setq att (ssname atx (setq bbb (1+ bbb))))
(setq tmp (cdr (assoc 1 (entget att))))
(setq tmp (list
(cons 0 "ATTRIB")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 100 "AcDbAttribute")
(cons 1 tmp)
(cons 2 (substr tmp 1 10))
(cons 6 "ByBlock")
(cons 7 "STANDARD")
(cons 8 "0")
(list 10 0.0 0.0 0.0)
(list 11 0.0 0.0 0.0)
(cons 40 1.0)
(cons 41 1.0)
(cons 50 0.0)
(cons 51 0.0)
(cons 62 256)
(cons 70 0)
(cons 72 0)
(cons 73 0)
)
)
)
(progn
(foreach bbb '(7 8 10 11 40 41 50 51 72 73)
(setq
tmp (subst (cons bbb (cdr (assoc bbb (entget att))))
(assoc bbb tmp)
tmp
)
)
)
(setq nxx (cons tmp nxx))
)
)
)
(setq nxx (cons (list (cons 0 "SEQEND")
(cons 100 "AcDbEntity")
(cons 8 (cdr (assoc 8 blk)))
)
nxx
)
)
(mapcar 'entmake (reverse nxx))
(setq rtn (entlast))
(if (and erase
(setq bbb -1)
(entdel (cdr (assoc -1 blk)))
)
(repeat (sslength atx)
(entdel (ssname atx (setq bbb (1+ bbb))))
)
)
)
)
rtn
)

(Defun vlobj-attach-attrib (blk atx erase / att bbb nxx tmp rtn) 
  (setq        bbb blk 
        blk (entget bbb) 
  ) 
  (if (not (assoc 66 blk)) 
    (setq blk (append blk (list (cons 66 1)))) 
  ) 
  (setq nxx (list blk)) 
  (if (and (entnext bbb) 
           (= (cdr (assoc 0 (entget (entnext bbb)))) "ATTRIB") 
      ) 
    (while 
      (/= (cdr (assoc 0 (entget (setq bbb (entnext bbb))))) 
          "SEQEND" 
      ) 
       (setq nxx (cons (entget bbb) nxx)) 
    ) 
  ) 
  (if (= (type atx) 'ename) 
    (setq atx (ssadd atx)) 
  ) 
  (if (and (= (type atx) 'pickset) 
           (setq bbb -1) 
      ) 
    (progn       
      (repeat (sslength atx) 
        (if (and (setq att (ssname atx (setq bbb (1+ bbb)))) 
                 (setq tmp (cdr (assoc 1 (entget att))))   
                 (setq tmp (list 
                             (cons 0 "ATTRIB") 
                             (cons 100 "AcDbEntity") 
                             (cons 100 "AcDbText") 
                             (cons 100 "AcDbAttribute") 
                             (cons 1 tmp) 
                             (cons 2 (substr tmp 1 10)) 
                             (cons 6 "ByBlock") 
                             (cons 7 "STANDARD") 
                             (cons 8 "0") 
                             (list 10 0.0 0.0 0.0) 
                             (list 11 0.0 0.0 0.0) 
                             (cons 40 1.0) 
                             (cons 41 1.0) 
                             (cons 50 0.0) 
                             (cons 51 0.0) 
                             (cons 62 256) 
                             (cons 70 0) 
                             (cons 72 0) 
                             (cons 73 0) 
                           ) 
                 ) 
            ) 
          (progn 
            (foreach bbb '(7 8 10 11 40 41 50 51 72 73) 
              (setq 
                tmp (subst (cons bbb (cdr (assoc bbb (entget att)))) 
                           (assoc bbb tmp) 
                           tmp 
                    ) 
              ) 
            ) 
            (setq nxx (cons tmp nxx)) 
          ) 
        ) 
      ) 
      (setq nxx        (cons (list (cons 0 "SEQEND") 
                            (cons 100 "AcDbEntity") 
                            (cons 8 (cdr (assoc 8 blk))) 
                      ) 
                      nxx 
                ) 
      ) 
      (mapcar 'entmake (reverse nxx)) 
      (setq rtn (entlast)) 
      (if (and erase 
               (setq bbb -1) 
               (entdel (cdr (assoc -1 blk))) 
          ) 
        (repeat        (sslength atx) 
          (entdel (ssname atx (setq bbb (1+ bbb)))) 
        ) 
      ) 
    ) 
  ) 
  rtn 
)

mmmm · 发表于 2007-2-2 13:47:01

Simple VL command

;;;No error check, ugly codes only, not fully tested
(Defun c:addatt (/ blk txt yn)
(if
(and (setq blk (entsel "\n Please pick the block <Exit>:"))
(setq blk (Car blk))
(= (cdr (assoc 0 (entget blk))) "INSERT")
(null (redraw blk 3))
(princ
"\n Please select text to be attached as attributes <Exit>:"
)
(setq txt (ssget '((0 . "text"))))
)
(progn
(initget "Yen No")
(if (null (setq yn
(getkword "\n Erase the attached texts [Yes/No] <Yes>:")
)
)
(setq yn "Yes")
)
(vlobj-attach-attrib blk txt (equal yn "Yes"))
)
)
)

eachy · 发表于 2007-2-2 13:55:02

加入属性的 blockdef 仅影响后面 Insert 的图块，以前Insert的 Block 仍旧为不含属性的图块

mmmm · 发表于 2007-2-2 13:58:28

此函数仅对点取的图块有效，不会影响之前或之后插入的图块。

LUCAS · 发表于 2007-2-5 07:58:48

;;很有趣的結構--是圖塊參考帶屬性,非改變原圖塊為屬性圖塊
;;即相同的圖塊名稱,但有的帶屬性,有的卻沒有屬性
;;這會做成處理圖塊程序的複雜度
;;雖然看起來很方便,但個人認為能不用就不要用

eachy · 发表于 2007-2-5 08:18:27

和这个帖子讨论的是一个问题
http://www.xdcad.net/forum/showthread.php?s=&threadid=562307

yuleihz888 · 发表于 2007-2-6 12:26:24

YMOLD外挂在这方面非常不错

libo2000 · 发表于 2007-2-25 20:37:44

lsp如果修改删除属性文字？

jx2008 · 发表于 2007-5-28 14:31:43

我现在只关心怎么修改blockdef

pxt2001 · 发表于 2007-6-14 21:00:05

最初由 mmmm 发布
[B]Simple VL command
[code]
;;;No error check, ugly codes only, not fully tested
(Defun c:addatt (/ blk txt yn)
(if
(and (setq blk (entsel "\n Please pick the block <Exit>:"))
(setq blk (Ca... [/B]

输入 addatt 后,在cad2004中无法双击编辑, (可用attedit编辑)

双击时命令行提示:
[php]
命令: _.eattedit
此图形不包含带属性的块。
命令: 6757.338078,-91.268613,0.000000
未知命令“6757.338078,-91.268613,0.000000”。按 F1 查看帮助。
[/php]
请问能否做一个可以在cad2004双击编辑的属性块

yoyoho · 发表于 2008-12-27 22:27:07

楼主可否测试一下程序ddatt.lsp
,为何测试老是不成功阿!

beiwenxiao · 发表于 2009-1-5 18:54:39

看到函数就头痛........落过

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

[LISP函数]：添加普通文字到图块成为属性

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子