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

(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 . "")
          ;
          '(-4 . "")
          )
          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