加載AutoLabelAttributesV1-0.lsp
;;-----------------=={ AutoLabel Attributes }==---------------;;
;; ;;
;; Automatically labels a specific attribute in a set of ;;
;; blocks, renumbering if blocks are added, copied or ;;
;; erased. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.0 - 14-09-2011 ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;; Settings ;;
;;------------------------------------------------------------;;
;; [Note: Block names and Attribute Tags are *not* case-sensitive]
(setq *blockname* "c1" ;; Name of Block to be Updated
*blocktag* "1" ;; Attribute Tag to be Updated
)
;;------------------------------------------------------------;;
;; Main Program ;;
;;------------------------------------------------------------;;
(defun ObjectReactorCallback:RenumberBlocks ( object reactor params )
(setq *reactor* reactor)
(vlr-command-reactor "temp" '((:vlr-commandended . CommandReactorCallback:RenumberBlocks)))
(vlr-remove reactor)
(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 (entget e)
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 (entget e)
)
)
(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 (entget e)
)
)
(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)
)
)
)
)
)
)
(princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
教程：
基坑支護樁位編號及坐標提取插件應用
一、支護樁樁位編號
第一步：首先CAD內使用定義屬性命令att，如圖：
標記位置輸入任意數字，此處以“1”為列子，確認后將1放於即將編號的樁位旁。
第二步：找到繪圖-塊-創建塊命令，如圖：
注：此處名稱后面會應用，且多次編號的名稱不能重復。
名稱輸入任意數字，此處以“123”為例子，點擊選擇對象，選取剛創建的數字1空格。彈出新對話框，直接確認，如圖：
注：此處標記的數字為即將編號的起始數字，后面會應用。
此處以數字“1”作為例子，然后確認。
第三步：打開插件，如圖：
將前面設置的名稱和標記輸入對應位置並保存，如圖：
第四步：找到工具-加載應用程序，選擇插件加載，如圖：
第五步：CP復制數字1按順序往后，空格后會自動生成編號。如圖：
二、樁位坐標拾取
第一步：使用PL多線段命令，對象捕捉修改為僅捕捉圓心，將所有要拾取坐標的樁位中心點進行連線。如圖：
第二步：選中剛畫出的多段線，輸入LI命令，空格，將彈出窗口內的內容復制到Excel工作表。如圖：
第三步：工作表內找到數據-分列，選中分隔符號-下一步，設置“空格和=分列”,繼續下一步完成，如圖:
第四步：調整板式。如圖：
三、有用得上的請保留，用不上的請勿噴，謝謝。教程有寫得不清楚的地方請致電15288211020。
附贈辦公室無天正軟件時，CAD坐標標注插件。
（詳細后附壓縮包）