飞扬工具集中的智能图框源代码

豆角 · 发表于 2013-5-12 08:18

本帖最后由豆角于 2013-5-19 10:07 编辑

智能图框源代码实现以下功能：
当修改完块参照的“比例”属性后，块参照的真实比例及标注比例、线型比例将跟随变化；
当修改完块参照的真实比例后，块参照的“比例”属性及标注比例、线型比例将跟随变化。
我用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-obj scale 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 . "<or")
;
'(-4 . "<and")
'(0 . "DIMENSION")
(cons 3 dimstyle-name)
'(-4 . "and>")
;
'(-4 . "<and")
'(0 . "LEADER")
(cons 3 dimstyle-name)
'(-4 . "and>")
)
ss-filter
)
)
(setq ss (ssget "X" ss-filter))
ss
)
(setq AcadObject (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

(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-obj  scale     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 . "<or") 
          ; 
          '(-4 . "<and") 
          '(0 . "DIMENSION") 
          (cons 3 dimstyle-name) 
          '(-4 . "and>") 
          ; 
          '(-4 . "<and") 
          '(0 . "LEADER") 
          (cons 3 dimstyle-name) 
          '(-4 . "and>") 
 
          ) 
          ss-filter 
        ) 
    ) 
    (setq ss (ssget "X" ss-filter)) 
    ss 
  ) 
   
  (setq  AcadObject   (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

nijiea123 · 发表于 2022-7-21 13:25

这个必须支持很不错呀

huxu823 · 发表于 2020-6-11 23:47

这个必须收下，感谢分享

白色微風1991 · 发表于 2022-7-21 07:58

好東西，下載下來試試！

chshsl · 发表于 2013-5-12 09:02

谢谢分享，

davide888 · 发表于 2013-5-12 10:21

可以布局使用不？

豆角 · 发表于 2013-5-12 10:30

在模型和布局中都可以使用。

yaokui25 · 发表于 2013-5-12 10:53

嘿嘿~支持楼主留个脚印

注册 · 发表于 2013-5-12 20:39

有效果图吗？？？

sicky111 · 发表于 2013-5-12 22:50

这个要顶。

完整武器 · 发表于 2013-5-12 23:21

顶下谢谢楼主分享！！1

jhwjm369 · 发表于 2013-5-13 10:59

能不能单独使用的啊。。。。。。。。。

豆角 · 发表于 2013-5-13 16:38

这已经是完整的源代码了！学vlisp的朋友不妨制作一个以A0、A1、A2、A3或A4为名称，且带“比例”属性的块试一试。

账号		自动登录	找回密码
密码			注册

[源码] 飞扬工具集中的智能图框源代码

评分

相关帖子