飞扬工具集中的智能图框源代码
智能图框源代码实现以下功能：当修改完块参照的“比例”属性后，块参照的真实比例及标注比例、线型比例将跟随变化；
当修改完块参照的真实比例后，块参照的“比例”属性及标注比例、线型比例将跟随变化。
我用vlisp写成的，代码如下：
(vl-cmdf "_.undefine" ".insert");;只加载一次
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
(defun c:insert(/)
(vlr-add cmd-reactorfeiy-frame)
(vla-SendCommand
(vla-get-ActiveDocument (vlax-get-acad-object))
"_.insert "
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;命令反应器
(vl-load-com)
(setq cmd-reactorfeiy-frame
(vlr-editor-reactor
nil
'((:vlr-commandEnded . cmdEndedfeiy-frame))
)
)
(vlr-remove cmd-reactorfeiy-frame)
;;;;;;;;;;;;;;;;;;;;
;;命令反应器回调函数
(defun cmdEndedfeiy-frame (reactor lst /
feiyold_error feiyatt-obj
feiybk-objscale dz
scale-str ratio
)
;;错误处理函数
(setq feiyold_error *error*)
(defun *error* (msg)
(setq feiybk-scale-obj '())
(setq feiybk-scale-att '())
(setq *error* feiyold_error)
(vlr-remove cmd-reactorfeiy-frame)
(princ)
)
;;
;;为块添加反应器
(cond
((equal '("DROPGEOM") lst)
(feiybk-add-reactor (entlast))
)
((or (equal '("PASTECLIP") lst)
(and (equal '("COPY") lst) is-feiybk-copied)
)
(setq is-feiybk-copied nil)
(feiy-LAutoframe)
)
((equal '("INSERT") lst)
(feiybk-add-reactor (entlast))
(vla-put-XEffectiveScaleFactor
(vlax-ename->vla-object (entlast))
(vla-get-XEffectiveScaleFactor
(vlax-ename->vla-object (entlast))
)
)
)
(t nil)
)
;;块引发更新动作
(if (and feiybk-scale-obj
(not (equal '("ACDCATTEDIT") lst))
(not (equal '("EATTEDIT") lst))
(setq feiyatt-obj (car feiybk-scale-obj))
(setq feiybk-obj (cadr feiybk-scale-obj))
(setq scale (caddr feiybk-scale-obj))
(/= scale (atof (vla-get-TextString feiyatt-obj)))
)
(progn
(setq dz (getvar "dimzin"))
(setvar "dimzin" 8)
(setq scale-str (rtos scale 2 6))
(setvar "dimzin" dz)
(vla-put-TextString feiyatt-obj scale-str)
(feiyupdate-sacle scale)
(setq feiybk-scale-obj '())
(setq feiybk-scale-att '())
)
)
;;属性引发更新动作
(if (and feiybk-scale-att
(setq feiyatt-obj (car feiybk-scale-att))
(setq feiybk-obj (cadr feiybk-scale-att))
(setq ratio (caddr feiybk-scale-att))
(or (/= ratio (vla-get-XEffectiveScaleFactor feiybk-obj))
(equal '("ACDCATTEDIT") lst)
(equal '("EATTEDIT") lst)
)
)
(progn
(if (/= ratio (vla-get-XEffectiveScaleFactor feiybk-obj))
(vla-put-XEffectiveScaleFactor feiybk-obj ratio)
)
(if (/= ratio (vla-get-YEffectiveScaleFactor feiybk-obj))
(vla-put-YEffectiveScaleFactor feiybk-obj ratio)
)
(if (/= ratio (vla-get-ZEffectiveScaleFactor feiybk-obj))
(vla-put-ZEffectiveScaleFactor feiybk-obj ratio)
)
(feiyupdate-sacle ratio)
(setq feiybk-scale-att '())
(setq feiybk-scale-obj '())
)
)
;;反应器失效
(vlr-remove cmd-reactorfeiy-frame)
(setq *error* feiyold_error)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;块回调函数
(defun feiybk-calling
(owner reactor lst / feiyold_error feiyatt-obj scale)
(setq feiyold_error *error*)
(defun *error* (msg)
(setq feiybk-scale-obj '())
(setq *error* feiyold_error)
(princ)
)
(setq feiyatt-obj (vlr-Data reactor))
(setq scale (vla-get-XEffectiveScaleFactor owner))
(setq feiybk-scale-obj (list feiyatt-obj owner scale))
;反应器激活
(vlr-add cmd-reactorfeiy-frame)
(setq *error* feiyold_error)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;属性回调函数
(defun feiyatt-calling
(owner reactor lst / feiyold_error feiybk-obj ratio)
(setq feiyold_error *error*)
(defun *error* (msg)
(setq feiybk-scale-att '())
(setq *error* feiyold_error)
(princ)
)
(setq feiybk-obj (vlr-Data reactor))
(setq ratio (atof (vla-get-TextString owner)))
(if (/= 0 ratio)
(progn
(setq feiybk-scale-att (list owner feiybk-obj ratio))
(vlr-add cmd-reactorfeiy-frame);反应器激活
)
(setq feiybk-scale-att '())
)
(setq *error* feiyold_error)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;块复制回调函数
(defun feiybk-copied (owner reactor lst /)
(setq is-feiybk-copied t)
(vlr-add cmd-reactorfeiy-frame);反应器激活
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;为块添加反应器函数,ent为任意图元
(defun feiybk-add-reactor (ent /
feiyold_error obj
ObjectName Name
atts feiyatt-list
feiyatt-obj feiyatt-obj-Reactor
feiybk-obj-Reactor
feiyatt-obj-xmmc feiyatt-obj-tzmc
str
)
(setq feiyold_error *error*)
(defun *error* (msg)
(setq *error* feiyold_error)
(vlr-remove cmd-reactorfeiy-frame)
(princ)
)
(setq obj (vlax-ename->vla-object ent))
(setq ObjectName (vla-get-ObjectName obj))
(setq Name (vla-get-effectivename obj))
(if (and (= "AcDbBlockReference" ObjectName)
(or (= "A0" Name)
(= "A1" Name)
(= "A2" Name)
(= "A3" Name)
(= "A4" Name)
)
(= :vlax-true (vla-get-HasAttributes obj))
)
(progn
(setq atts (vlax-invoke-method obj 'GetAttributes))
(setq
feiyatt-list
(vlax-safearray->list (vlax-variant-value atts))
)
;;
(setq
feiyatt-obj
(car (vl-member-if
'(lambda (x) (= "比例" (vla-get-TagString x)))
feiyatt-list
)
)
)
;属性反应器
(setq feiyatt-obj-Reactor
(vlr-object-reactor
(list feiyatt-obj)
obj
'((:vlr-objectClosed . feiyatt-calling)
)
)
)
;块反应器
(setq feiybk-obj-Reactor
(vlr-object-reactor
(list obj)
feiyatt-obj
'((:vlr-objectClosed . feiybk-calling)
(:vlr-copied . feiybk-copied)
(:vlr-erased . feiybk-erased)
(:vlr-unerased . feiybk-unerased)
(:vlr-modified . feiybk-modified)
(:vlr-subObjModified . feiybk-subObjModified)
)
)
)
;;为图框中的多行文本添加段落标记
(foreach x feiyatt-list
(if (= :vlax-true (vla-get-mtextattribute x))
(progn
(setq str (vla-get-TextString x))
(if(/= 0 (vl-string-search "\\p" str))
(progn
(setq str (strcat "\\pxsm1,qc;" str))
(vla-put-TextString x str)
)
)
)
)
)
)
)
(setq *error* feiyold_error)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun feiybk-erased (owner reactor lst /)
(princ)
)
(defun feiybk-unerased (owner reactor lst /)
(princ)
)
(defun feiybk-modified (owner reactor lst /)
(princ)
)
(defun feiybk-subObjModified (owner reactor lst /)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;更新标注比例、线型比例函数
(defun feiyupdate-sacle(sacle / feiyold_error
ss-setup AcadObject AcadDocument
mSpace dimstyle dimstyle-name
ss n
)
(setq feiyold_error *error*)
(defun *error* (msg)
(setq *error* feiyold_error)
(princ)
)
;;选择集:包括尺寸标注对象和非连续线型图层上的对象
(defun ss-setup (dimstyle-name / odoc ss-filter item layer-name ss)
(setq odoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq ss-filter '((-4 . "or>")))
(vlax-for item (vla-get-LineTypes odoc)
(if (and (/= "Continuous" (vla-get-name item))
(/= "ByLayer" (vla-get-name item))
(/= "ByBlock" (vla-get-name item))
)
(progn
(setq ss-filter (cons (cons 6 (vla-get-name item)) ss-filter))
)
)
)
;
(vlax-for item (vla-get-layers odoc)
(if (/= "Continuous" (vla-get-LineType item))
(progn
(setq layer-name (vla-get-name item))
(setq ss-filter (cons (cons 8 layer-name) ss-filter))
)
)
)
;
(setq ss-filter (append (list '(-4 . "")
;
'(-4 . "")
)
ss-filter
)
)
(setq ss (ssget "X" ss-filter))
ss
)
(setqAcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(setvar "ltscale" sacle)
(setvar "TEXTSIZE" (* 4.0 sacle))
(vla-setvariable AcadDocument "dimscale" sacle)
(setq dimstyle (vla-get-activedimstyle AcadDocument))
(setq dimstyle-name (vla-get-name dimstyle))
(vla-copyfrom dimstyle mSpace)
(setq ss (ss-setup dimstyle-name))
(if ss
(progn
(setq n 0)
(repeat (sslength ss)
(vla-update (vlax-ename->vla-object (ssname ss n)))
(setq n (1+ n))
)
)
)
(setq *error* feiyold_error)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;文档打开反应器
(setq feiydwgFOpened-refr
(vlr-dwg-reactor
nil
'((:vlr-dwgFileOpened . dwgFOpenedfeiy-frame))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;文档打开反应器回调函数
(defun dwgFOpenedfeiy-frame (reactor lst)
;反应器激活
(vlr-add cmd-reactorfeiy-frame)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;块插入反应器
(vlr-insert-reactor
nil
'((:vlr-endInsert . endInsertfeiy-frame))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;块插入反应器回调函数
(defun endInsertfeiy-frame (reactor lst)
;反应器激活
(vlr-add cmd-reactorfeiy-frame)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;将打开图形中的已有图框附上对象反应器
(defun feiy-LAutoframe (/ feiyold_error ent feiybk-ss feiyold_error n)
(setq feiyold_error *error*)
(defun *error* (msg)
(setq *error* feiyold_error)
(princ)
)
(setq feiybk-ss (ssget "X" '((0 . "INSERT"))))
(setq n 0)
(if feiybk-ss
(repeat (sslength feiybk-ss)
(setq ent (ssname feiybk-ss n))
(feiybk-add-reactor ent)
(setq n (1+ n))
)
)
(setq *error* feiyold_error)
)
(feiy-LAutoframe)
;;end 这个必须支持 很不错呀 这个必须收下，感谢分享 好東西，下載下來試試！ 谢谢分享， 可以布局使用不？ 在模型和布局中都可以使用。 嘿嘿~支持楼主留个脚印
有效果图吗？？？ 这个要顶。
页:
[1]
2