创建属性自动编号
你好我对AutoLISP比较陌生，但了解其原理。
我正在尝试为已经在另一个程序中绘制并导入为DXF的单个树自动生成一个数字。
我希望自动编号是一个属性，这样我可以将编号和X&Y数据导出到。CSV文件，然后我可以在其他地方使用。
我无法确定自动生成器是否会生成一个逻辑数字序列，或者这些数字是否只是随机出现在树状结构中。在这种情况下，我还可以使用自动生成的编号创建一个新块，并按我想要的顺序定位这些块。
任何帮助都将不胜感激。
干杯，阿利斯泰尔。 嗨，阿利斯泰尔，
一个程序可以用来对你的树进行编号，可能是从左到右或从上到下（反之亦然）等等。所有块的标记名是否都相同？
李 是的，所有树的标记名都是相同的。
我发现通常我会以顺时针或逆时针的方式对树进行编号。
谢谢你的帮助。 嗨，阿利斯泰尔，
请尝试这个函数，它将以升序递增按Y坐标排序的属性数，因为我不太确定你说的顺时针是什么意思？围绕中心块顺时针旋转？
根据需要更改标记名称（顶部）。
(defun c:AttNum (/ *error* MakeVariant Itemp MakeSelectionSet
DOC OBJ OBJECTLIST SS TAG UFLAG)
(vl-load-com)
;; Lee Mac~15.04.10
(setq tag "TAG1")
(defun *error* (msg)
(if uFlag
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun MakeVariant (data datatype)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray (eval datatype)
(cons 1 (length data))
)
data
)
)
)
(defun Itemp (collection item / result)
(if (not (vl-catch-all-error-p
(setq result
(vl-catch-all-apply
(function vla-item) (list collection item)
)
)
)
)
result
)
)
(defun MakeSelectionSet (ref / SelSets SelSet)
(if (setq SelSet
(itemp
(setq SelSets
(vla-get-SelectionSets
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
ref
)
)
(vla-delete SelSet)
)
(vla-add SelSets ref)
)
(setq *start
(cond
(*start) ( 1 )
)
)
(setq *start
(1-
(cond
((getint
(strcat "\nSpecify Starting Number <"
(itoa *start) "> : "
)
)
)
(*start)
)
)
)
(if (zerop
(vla-get-Count
(setq ss
(vla-get-PickFirstSelectionSet
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
)
)
(progn
(setq ss (MakeSelectionSet "Tree_SS"))
(vla-SelectOnScreen ss
(MakeVariant '(0 66) vlax-vbInteger)
(MakeVariant '("INSERT" 1) vlax-vbVariant)
)
)
)
(if (not
(zerop
(vla-get-Count ss)
)
)
(progn
(setq UFlag
(not
(vla-StartUndoMark doc)
)
)
(vlax-for obj ss
(setq ObjectList
(cons
(cons obj
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property obj 'InsertionPoint)
)
)
)
ObjectList
)
)
)
(vla-delete ss)
(mapcar
(function
(lambda ( block )
(mapcar
(function
(lambda ( attribute )
(if (eq tag (vla-get-TagString attribute))
(vl-catch-all-apply (function vla-put-TextString)
(list attribute (itoa (setq *start (1+ *start))))
)
)
)
)
(vlax-invoke block 'GetAttributes)
)
)
)
(mapcar (function car)
(vl-sort ObjectList
(function
(lambda ( point1 point2 )
(< (caddr point1) (caddr point2))
)
)
)
)
)
(setq UFlag
(vla-EndUndoMark doc)
)
)
)
(princ))
你好，李，
非常感谢你的帮助；但是，没有显示数字。
这可能是我没有在块属性中设置的吗？
非常感谢
阿利斯泰尔 代码顶部的标记名是否正确？ 非常感谢你的帮助，李，它正在工作。
随着我的进步，我可能需要帮助，并尝试自动化更多的绘图过程。
非常感谢，
阿利斯泰尔 根据PM的要求：
(defun c:AttNum (/ tag dxf ent eLst)
(setq dxf (lambda (c l) (cdr (assoc c l))))
(setq tag "TAG1") ;; Tag to be Updated
(setq *start (cond (*start) ( 1 ))
*start (1- (cond ((getint (strcat "\nSpecify Starting Number <"
(itoa *start) "> : ")))
(*start))))
(while
(progn
(setq ent (car (entsel (strcat "\nSelect Block Number "
(itoa (setq *start (1+ *start))) " <Exit> : "))))
(cond ((eq 'ENAME (type ent))
(if (and (eq "INSERT" (dxf 0 (entget ent)))
(= 1 (dxf 66 (entget ent))))
(while (not (eq "SEQEND" (dxf 0 (setq eLst (entget (setq ent (entnext ent)))))))
(if (eq tag (dxf 2 elst))
(entupd
(dxf -1
(entmod
(subst
(cons 1 (itoa *start)) (assoc 1 eLst) eLst)))) t))
(princ "\n** Must be an Attributed Block **"))))))
(princ))
为了所有人的利益而发布。 哦，哇，非常感谢李，你甚至让它要求标签，而不是停留在Lisp程序。。我喜欢我喜欢
再次感谢您抽出时间。
詹姆斯 不客气，詹姆斯
页:
[1]
2