求助
本帖最后由 305341043 于 2023-4-3 16:37 编辑(defun C:C3 ()
(defun PutAttrib (Obj ValTable / AttList)
(setq AttList (vlax-safearray->list (vlax-variant-value (vlax-invoke-method Obj 'GetAttributes))))
(foreach Att AttList
(if (setq AttVal (assoc (vlax-get-property Att 'TagString) ValTable))
(vlax-put-property Att 'TextString (cadr AttVal))
)
)
)
(defun GetAttrib (Obj / ValTable AttList AttCode)
(setq ValTable '())
(setq AttList (vlax-safearray->list (vlax-variant-value (vlax-invoke-method Obj 'GetAttributes))))
(foreach Att AttList
(if (setq AttCode (vlax-get-property Att 'TagString))
(setq ValTable (cons (list AttCode (vlax-get-property Att 'TextString)) ValTable))
)
)
ValTable
)
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (entsel))))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq typ (vla-get-ObjectName obj))
(cond
((= typ "AcDbText") (setq num (atoi (vla-get-TextString obj))))
((= typ "AcDbBlockReference") (setq num (atoi (cadar (GetAttrib obj)))))
(t (alert "\n选择不正确！") (exit))
)
(initget "D T S")
(setq i 1)
(while (setq result (getpoint pt "\n请选择插入点:[或递增(D)/不变(T)/递减(S)]"))
(cond
((= result "D")(setq i 1))
((= result "T")(setq i 0))
((= result "S")(setq i -1))
((= (type result) 'list)
(setq newobj (vla-Copy obj))
(setq num (+ num i))
(cond
((= typ "AcDbText") (vla-put-TextString newobj (itoa num)))
((= typ "AcDbBlockReference") (PutAttrib newobj (list (list "M" (itoa num)))))
)
(vla-Move newobj (vlax-3D-point pt) (vlax-3D-point result))
(setq pt result obj newobj)
)
)
(initget "D T S")
)
(princ)
)
不能用的那个符号是块中块.程序没获得属性
页:
[1]