自动增减块编号求助
如图，在网上无意看到有这么一个东东。求方法？不会玩,用不上 http://lee-mac.com/autolabelattributes.html lrd1861 发表于 2015-3-7 15:25 static/image/common/back.gif
http://lee-mac.com/autolabelattributes.html
不会用。能说说怎么用这个吗？ 别人的程序，找不到原来的网页介绍了。加载lisp程序，然后输入znno命令。保存后，再打开就不好用了。 LEE大神的程序 很强大。。。
你可以将他的函数改为子函数
GET POINT 时再小修改一下就好了 ysq101 发表于 2015-3-7 20:56 static/image/common/back.gif
LEE大神的程序 很强大。。。
你可以将他的函数改为子函数
GET POINT 时再小修改一下就好了
我不会。能帮我改一个吗？ 长风（尚品） 发表于 2015-3-8 08:41 static/image/common/back.gif
我不会。能帮我改一个吗？
LEE大神的程序-----智能编号
;;;智能编号
(defun MakeBlock-no-DXF ()
(if (not (tblsearch "Style" "Standard"))
(progn
;;;entmake *** "STYLE" *** object:
(entmake (list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
'(2 . "Standard")
'(70 . 0)
'(40 . 0.0)
'(41 . 0.8)
'(50 . 0.0)
'(71 . 0)
'(42 . 3.0)
'(3 . "txt")
'(4 . "")
)
)
);End Progn
);End IF
(if (not (tblsearch "Layer" "0"))
(progn
;;;entmake *** "LAYER" *** object:
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "0")
'(70 . 0)
'(62 . 7)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
);End Progn
);End IF
(if (not (tblsearch "Block" "no"))
(progn
;;;entmake *** "BLOCK" *** object:
(entmake (list
'(0 . "BLOCK")
'(100 . "AcDbEntity")
'(67 . 0)
'(8 . "0")
'(100 . "AcDbBlockBegin")
'(70 . 2)
'(10 0.0 0.0 0.0)
'(2 . "no")
'(1 . "")
)
)
;;;entmake *** "ATTDEF" *** object:
(entmake (list
'(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
'(8 . "编号")
'(62 . 3)
'(100 . "AcDbText")
'(10 -0.5 -1.5 0.0)
'(40 . 0.8);;;字体大小
'(1 . "1")
'(50 . 0.0)
'(41 . 0.8)
'(51 . 0.0)
'(7 . "Standard")
'(71 . 0)
'(72 . 4)
'(11 1.77636e-015 0.0 0.0)
'(210 0.0 0.0 1.0)
'(100 . "AcDbAttributeDefinition")
'(3 . "no")
'(2 . "AAA")
'(70 . 0)
'(73 . 0)
'(74 . 0)
)
)
;;;entmake *** "CIRCLE" *** object:
(entmake (list
'(0 . "CIRCLE")
'(100 . "AcDbEntity")
'(67 . 0)
'(8 . "编号")
'(62 . 1)
'(100 . "AcDbCircle")
'(10 0.0 0.0 0.0)
'(40 . 0.8);;;半径大小
'(210 0.0 0.0 1.0)
)
)
;;;entmake *** "ENDBLK" *** object:
(entmake (list
'(0 . "ENDBLK")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockEnd")
)
)
(entupd (tblobjname "Block" "no"))
);End Progn
);End IF
)
;$$$$$$$$$$$$$$$$$$$$$$$
(DEFUN C:Znbh( )
(SETVAR "CMDECHO" 0)
(SETVAR "OSMODE" 0);关闭捕捉
(MakeBlock-no-DXF )
(COMMAND "_INSERT" "no" (getpoint "\n编号插入点:") 1 1 0)
(COMMAND "REGEN")
;;
(setq *blockname* "no";; 更新块名
*blocktag*"aaa" ;; 更新属性
)
(defun ObjectReactorCallback:RenumberBlocks ( object reactor params )
(setq *reactor* reactor)
(vlr-command-reactor "temp" '((:vlr-commandended . CommandReactorCallback:RenumberBlocks)))
(vlr-removereactor)
(princ)
)
(defun CommandReactorCallback:RenumberBlocks ( reactor params / e f i l n s )
(if reactor (vlr-remove reactor))
(if
(and
(not *undoflag*)
(setq s (ssget "_X" *filter*))
)
(progn
(setq n 0)
(repeat (setq i (sslength s))
(if (eq *blockname*
(AutoLabel:EffectiveName
(setq o (vlax-ename->vla-object (setq e (ssname s (setq i (1- i))))))
)
)
(progn
(setq e (entnext e)
l (entgete)
f nil
)
(while (and (not f) (eq "ATTRIB" (cdr (assoc 0 l))))
(if (eq *blocktag*(strcase (cdr (assoc 2 l))))
(setq f (entmod (subst (cons 1 (itoa (setq n (1+ n)))) (assoc 1 l) l)))
)
(setq e (entnext e)
l (entgete)
)
)
(if (and *reactor* (not (member o (vlr-owners *reactor*))))
(vlr-owner-add *reactor* o)
)
)
)
)
)
)
(if *reactor*
(progn (vlr-add *reactor*) (setq *reactor* nil))
)
(princ)
)
(defun CommandReactorCallback:UndoCheck ( reactor params )
(setq *undoflag* (wcmatch (strcase (car params)) "*U,*UNDO"))
(princ)
)
(defun CommandReactorCallback:BlockInserted ( reactor params / e l )
(if
(and
(not *undoflag*)
(wcmatch (strcase (car params)) "*I,*INSERT,*EXECUTETOOL")
(setq e (entlast))
(setq l (entget e))
(eq "INSERT" (cdr (assoc 0 l)))
(= 1 (cdr (assoc 66 l)))
(eq *blockname* (AutoLabel:EffectiveName (vlax-ename->vla-object e)))
)
(AutoLabel:GetNewNumber e)
)
(princ)
)
(defun AutoLabel:GetNewNumber ( ent / e f i l n r s )
(if (setq s (ssget "_X" *filter*))
(progn
(setq n 0)
(repeat (setq i (sslength s))
(if (eq *blockname*
(AutoLabel:Effectivename
(vlax-ename->vla-object (ssname s (setq i (1- i))))
)
)
(setq n (1+ n))
)
)
(setq e (entnext ent)
l (entget e)
)
(while (and (not f) (eq "ATTRIB" (cdr (assoc 0 l))))
(if (eq *blocktag*(strcase (cdr (assoc 2 l))))
(setq f (entmod (subst (cons 1 (itoa n)) (assoc 1 l) l)))
)
(setq e (entnext e)
l (entgete)
)
)
(if
(setq r
(vl-some
(function
(lambda ( r ) (if (eq *reacdata* (vlr-data r)) r))
)
(cdar (vlr-reactors :vlr-object-reactor))
)
)
(vlr-owner-add r (vlax-ename->vla-object ent))
)
)
)
(princ)
)
;;------------------------------------------------------------;;
(defun AutoLabel:EffectiveName ( obj )
(strcase
(if (vlax-property-available-p obj 'effectivename)
(vla-get-effectivename obj)
(vla-get-name obj)
)
)
)
;;------------------------------------------------------------;;
;; Loading Expressions ;;
;;------------------------------------------------------------;;
(vl-load-com)
(
(lambda ( / i s l o )
(setq
*blocktag*(strcase *blocktag*)
*blockname* (strcase *blockname*)
*reacdata*"AutoBlockLabel"
*reactor* nil
*undoflag*nil
)
(foreach r1 (vlr-reactors)
(foreach r2 (cdr r1)
(if (eq *reacdata* (vlr-data r2)) (vlr-remove r2))
)
)
(if
(setq s
(ssget "_X"
(setq *filter*
(list
'(0 . "INSERT")
'(66 . 1)
(cons 2 (strcat "`*U*," *blockname*))
(cons 410 (getvar 'CTAB))
)
)
)
)
(progn
(repeat (setq i (sslength s))
(if (eq *blockname*
(AutoLabel:EffectiveName
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
)
)
(setq l (cons o l))
)
)
(CommandReactorCallback:RenumberBlocks nil nil)
(vlr-object-reactor l *reacdata*
(list
(cons :vlr-erased 'ObjectReactorCallback:RenumberBlocks)
(cons :vlr-copied 'ObjectReactorCallback:RenumberBlocks)
(cons :vlr-unerased 'ObjectReactorCallback:RenumberBlocks)
)
)
(vlr-command-reactor *reacdata*
(list
(cons :vlr-commandwillstart 'CommandReactorCallback:UndoCheck)
(cons :vlr-commandended 'CommandReactorCallback:BlockInserted)
)
)
)
)
)
)
(COMMAND "REGEN")
(princ)
)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;; 本帖最后由 长风（尚品） 于 2015-3-8 13:11 编辑
香田里浪人 发表于 2015-3-8 09:00 static/image/common/back.gif
LEE大神的程序-----智能编号
;;;智能编号
(defun MakeBlock-no-DXF ()
非常感谢。正需要这个 能不能改一个数字可以加前后缀。将圆改为方形
页:
[1]