如何修改为单行文字加缀，各位老大！
(defun C:hz (/ newname backfixEP1 EP2 EP1x EP2x blkname nametag i j)(setvar "cmdecho" 0)
(setq backfix (getstring "\n 输入要加入的后缀内容："))
(xuanze)
(genggai)
(princ (strcat "共计" (rtos (sslength ss) 2) "个属性块已加入后缀。"))
(princ)
)
(defun xuanze ()
(if (setq EP1 (entsel"点选要加后缀的属性字:\n"))
(progn (setq EG1 (cdr (assoc 0 (entget (car EP1)))))
(if (= EG1 "INSERT")
(progn (setq EG1x (car (nentselp (cadr EP1))))
(if (= (cdr (assoc 0 (entget EG1x))) "ATTRIB")
(setq nametag (cdr (assoc 2 (entget EG1x)))) ;标记
(progn(alert "******必须选择属性字!******")(xuanze))
)
(setq EP1st (entget (car EP1)))
(setq blkname (cdr (assoc 2 EP1st)))
)
(progn(alert "******必须选择属性字，或按ESC键退出!******")(xuanze))
)
)
(progn(alert "******必须选择属性字，或按ESC键退出!******")(xuanze))
)
)
(defun genggai ()
(princ "\n 请选择要修改的属性块：")
(setq ss (ssget (list '(0 . "insert") (cons 2 blkname)) ))
(setq i 0)
(while (< i (sslength ss))
(setq tk (ssname ss i))
(vl-load-com)
(setq obj (vlax-ename->vla-object tk))
(setq shuxing
(mapcar '(lambda (att)
(cons (vla-get-TagString att) (vla-get-TextString att))
)
(vlax-invoke obj "GetAttributes")
)
)
(setq name (cdr (assoc nametag shuxing)))
(setq newname (strcat name backfix))
(xz-att1 tk nametag newname)
(setq i (+ i 1))
)
)
(defun xz-att1 (ent tag string / liST0 liST1 num blkref)
(vl-load-com)
(if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference")
(if (vla-Get-HasAttributes blkref)
(progn (setq liST0 (vlax-safearray->list(vlax-variant-value (vla-GetAttributes blkref))))
(setq liST1 (mapcar 'vla-Get-TagStringliST0))
(setq num (vl-position tag list1))
(vla-put-TextString (nth num liST0) string)
)
); endif
); endif
(prin1)
); enddefun
纯支持一下，等待高手解答。。。。。
页:
[1]