[分享]有關點選亮顯xref內物件的貼子

龙龙仔 · 发表于 2004-11-5 17:31:00

有关点选亮显xref内物件的贴子

http://discussion.autodesk.com/thread.jspa?threadID=365179

无痕 · 发表于 2004-11-5 19:42:00

顶一下

;;;BY LUCAS
;;; highlighted not support objects inside xref-----ployline=AcDb2dVertex ,AcDbAttribute
;;;
;;; Block Isolate
;;;
;;; Revised from original code:
;;; From: Jeff Mishler (jeff_m@cadvault.com)
;;; Subject: Re: Layiso and Blocks
;;; Newsgroups: autodesk.autocad.customization
;;; Date: 2004-08-24 15:09:03 PST
(defun ISOBLKLAY (BLOCKREF / GET_LAY_LIST BLOCK BLOCKLAY) ;; function to get layer list of block
(defun GET_LAY_LIST (BLK / LAY BLOCK)
(setq BLOCK
(vla-item (vla-get-blocks
DOC
) ;_ vla-get-blocks
(vla-get-name BLK)
) ;_ vla-item
) ;_ setq
(vlax-for ENT BLOCK
(setq LAY (vla-get-layer ENT))
(if (not (member LAY LAYLIST))
(setq LAYLIST (cons LAY LAYLIST))
) ;_ if
(if (= (strcase "AcDbBlockreference")
(strcase (vla-get-objectname ENT))
) ;_ =
(GET_LAY_LIST ENT)
) ;_ if
) ;_ vlax-for
) ;_ defun
;; select block to isolate
(and (setq BLOCK (vlax-ename->vla-object BLOCKREF))
(= (strcase "AcDbBlockreference")
(strcase (vla-get-objectname BLOCK))
) ;_ =
;; get list of layers in block
(GET_LAY_LIST BLOCK)
) ;_ and
(setq LAY (cdr (assoc 8 (entget BLOCKREF))))
(if (not (member LAY LAYLIST))
(setq LAYLIST (cons LAY LAYLIST))
) ;_ if
LAYLIST
) ;_defun(defun ERR_LAI (S)
(if
(not (member S '("console break" "function cancelled")))
(princ (strcat "\nError: " S))
)
(command "" "_.erase" SS_DEL "")
(if OLDERR
(setq *ERROR* OLDERR)
)
(if HOLDECHO
(setvar "cmdecho" HOLDECHO)
)
(princ)
);;==========================
(defun C:SSISOBLK (/
LAYERS
DBXDOC
SS
SSI
ENT1
LAYLIST
LAY
MSPACE
ENT
VOBJ
MATRIX
COPYOBJ
ENT1
ID
ENTDBX
SS_DEL
DOC
) (vl-load-com)
(setq DOC (vla-get-activedocument (vlax-get-acad-object))
LAYERS (vla-get-layers DOC)
MSPACE (vla-get-modelspace DOC)
)
(vla-startundomark DOC) ;_ vla-startundomark
(setq OLDERR *ERROR*
*ERROR* ERR_LAI
)
(setq HOLDECHO (getvar "cmdecho"))
(setvar "CMDECHO" 0) (if (> (atoi (getvar "AcadVer")) 15)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.16"
)
)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument"
)
)
) ;;-------------Modify By LUCAS-------------
;;The Selecting objects in normal, just like "Block Isolate.lsp"
;;Select normal object,then "push enter" to Select object inside block
;;didn't hit "enter" twice please
(setq SS (ssget)) (if (not SS)
(setq SS (ssadd))
) (command "_.Select" SS) ;;Select Objects inside Xref
(setq SS_DEL (ssadd))
(while
(progn
(setvar "ERRNO" 0)
(setq
ENT
(nentselp
"\nSelect Objects inside Xref/<Enter exit>: "
)
)
(if (/= 52 (getvar "ERRNO"))
t
)
)
(if ENT
(progn
(prompt
(strcat
"\nObject layer = "
(setq LAY (cdr (assoc 8 (entget (car ENT)))))
)
) (if (not (member LAY LAYLIST))
(setq LAYLIST (cons LAY LAYLIST))
) (setq COPYOBJ (vlax-ename->vla-object (car ENT))) (cond
((and
(> (length ENT) 2)
(cond
((and
(setq
XREFOBJ (vlax-ename->vla-object
(car (last ENT))
)
)
(vlax-property-available-p XREFOBJ "PATH")
)
)
((and
(setq
XREFOBJ (vlax-ename->vla-object
(cadr (last ENT))
)
)
(vlax-property-available-p XREFOBJ "PATH")
)
)
)
) (vla-open DBXDOC (vla-get-path XREFOBJ))
(setq VOBJ (vlax-ename->vla-object (car ENT)))
(setq ID (vla-get-handle VOBJ))
(vlax-for ENT1 (vla-get-blocks DBXDOC)
(vlax-for ENTDBX ENT1
(if (= ID (vla-get-handle ENTDBX))
(setq VOBJ ENTDBX)
)
)
)
(setq MATRIX (caddr ENT))
(setq
COPYOBJ
(car
(vlax-invoke
DBXDOC
'COPYOBJECTS
(list VOBJ)
(if
(or (= (getvar "TILEMODE") 1)
(> (getvar "CVPORT") 1)
)
(vla-get-modelspace DOC)
(vla-get-paperspace DOC)
)
)
)
)
(vla-transformby COPYOBJ (vlax-tmatrix MATRIX))
(ssadd (entlast) SS_DEL)
)
) (vla-highlight COPYOBJ :vlax-true)
)
)
)
(command "") (while (/= (sslength SS) 0)
(setq ENT1 (ssname SS 0))
(if (= (cdr (assoc 0 (entget ENT1))) "INSERT")
(setq LAYLIST
(foreach ITEM (ISOBLKLAY (ssname SS 0))
(setq LAYLIST (cons ITEM LAYLIST))
)
)
(progn
(setq LAY (cdr (assoc 8 (entget (ssname SS 0)))))
(if (not (member LAY LAYLIST))
(setq LAYLIST (cons LAY LAYLIST))
) ;_ if
)
)
(ssdel (ssname SS 0) SS)
)
;; if layers found, isolate layers
(if LAYLIST
(progn
(vlax-for LAY LAYERS
(if (not (member (vla-get-name LAY) LAYLIST))
;; turn off layers not in block
(vla-put-layeron LAY :vlax-false)
;; turn on layers in block
(vla-put-layeron LAY :vlax-true)
) ;_ if
) ;_ vlax-for
) ;_progn
) ;_ if (command "_.erase" SS_DEL "")
(setq *ERROR* OLDERR)
(vla-endundomark DOC) ;_ vla-endundomark
(vlax-release-object DOC)
(vlax-release-object LAYERS)
(vlax-release-object MSPACE)
(vlax-release-object DBXDOC)
(setvar "cmdecho" HOLDECHO)
(princ)
) ;_ defun

;;;BY LUCAS
;;; highlighted not support objects inside xref-----ployline=AcDb2dVertex ,AcDbAttribute
;;;
;;; Block Isolate
;;;
;;; Revised from original code:
;;; From: Jeff Mishler (jeff_m@cadvault.com)
;;; Subject: Re: Layiso and Blocks
;;; Newsgroups: autodesk.autocad.customization
;;; Date: 2004-08-24 15:09:03 PST
(defun ISOBLKLAY (BLOCKREF / GET_LAY_LIST BLOCK BLOCKLAY)   ;; function to get layer list of block
   (defun GET_LAY_LIST (BLK / LAY BLOCK)
       (setq BLOCK
       (vla-item (vla-get-blocks
                 DOC
             ) ;_ vla-get-blocks
             (vla-get-name BLK)
       ) ;_ vla-item
       ) ;_ setq
       (vlax-for ENT BLOCK
           (setq LAY (vla-get-layer ENT))
           (if (not (member LAY LAYLIST))
  (setq LAYLIST (cons LAY LAYLIST))
           ) ;_ if
           (if (= (strcase "AcDbBlockreference")
           (strcase (vla-get-objectname ENT))
     ) ;_ =
  (GET_LAY_LIST ENT)
           ) ;_ if
       ) ;_ vlax-for
   ) ;_ defun
   ;; select block to isolate
   (and (setq BLOCK (vlax-ename->vla-object BLOCKREF))
             (= (strcase "AcDbBlockreference")
     (strcase (vla-get-objectname BLOCK))
             ) ;_ =
             ;; get list of layers in block
             (GET_LAY_LIST BLOCK)
   ) ;_ and
   (setq LAY (cdr (assoc 8 (entget BLOCKREF))))
   (if (not (member LAY LAYLIST))
       (setq LAYLIST (cons LAY LAYLIST))
   ) ;_ if
   LAYLIST
) ;_defun(defun ERR_LAI (S)
   (if
       (not (member S '("console break" "function cancelled")))
         (princ (strcat "\nError: " S))
   )
   (command "" "_.erase" SS_DEL "")
   (if OLDERR
       (setq *ERROR* OLDERR)
   )
   (if HOLDECHO
       (setvar "cmdecho" HOLDECHO)
   )
   (princ)
);;==========================
(defun C:SSISOBLK (/
         LAYERS
         DBXDOC
         SS
         SSI
         ENT1
         LAYLIST
         LAY
         MSPACE
         ENT
         VOBJ
         MATRIX
         COPYOBJ
         ENT1
         ID
         ENTDBX
         SS_DEL
         DOC
       )   (vl-load-com)
   (setq  DOC       (vla-get-activedocument (vlax-get-acad-object))
  LAYERS (vla-get-layers DOC)
  MSPACE (vla-get-modelspace DOC)
   )
   (vla-startundomark DOC) ;_ vla-startundomark
   (setq  OLDERR  *ERROR*
  *ERROR*  ERR_LAI
   )
   (setq HOLDECHO (getvar "cmdecho"))
   (setvar "CMDECHO" 0)   (if (> (atoi (getvar "AcadVer")) 15)
       (setq DBXDOC (vla-getinterfaceobject
         (vlax-get-acad-object)
         "ObjectDBX.AxDbDocument.16"
     )
       )
       (setq DBXDOC (vla-getinterfaceobject
         (vlax-get-acad-object)
         "ObjectDBX.AxDbDocument"
     )
       )
   )   ;;-------------Modify By LUCAS-------------
   ;;The Selecting objects in normal, just like "Block Isolate.lsp"
   ;;Select normal object,then "push enter" to Select object inside block
   ;;didn't hit "enter" twice please
   (setq SS (ssget))   (if (not SS)
       (setq SS (ssadd))
   )   (command "_.Select" SS)   ;;Select Objects inside Xref
   (setq SS_DEL (ssadd))
   (while
       (progn
           (setvar "ERRNO" 0)
           (setq
  ENT
   (nentselp
       "\nSelect Objects inside Xref/<Enter exit>: "
   )
           )
           (if (/= 52 (getvar "ERRNO"))
  t
           )
       )
         (if ENT
             (progn
   (prompt
       (strcat
           "\nObject layer = "
           (setq LAY (cdr (assoc 8 (entget (car ENT)))))
       )
   )   (if (not (member LAY LAYLIST))
       (setq LAYLIST (cons LAY LAYLIST))
   )   (setq COPYOBJ (vlax-ename->vla-object (car ENT)))   (cond
       ((and
             (> (length ENT) 2)
             (cond
    ((and
         (setq
             XREFOBJ (vlax-ename->vla-object
                   (car (last ENT))
               )
         )
         (vlax-property-available-p XREFOBJ "PATH")
     )
    )
    ((and
         (setq
             XREFOBJ (vlax-ename->vla-object
                   (cadr (last ENT))
               )
         )
         (vlax-property-available-p XREFOBJ "PATH")
     )
    )
             )
         )         (vla-open DBXDOC (vla-get-path XREFOBJ))
         (setq VOBJ (vlax-ename->vla-object (car ENT)))
         (setq ID (vla-get-handle VOBJ))
         (vlax-for ENT1 (vla-get-blocks DBXDOC)
             (vlax-for  ENTDBX ENT1
    (if (= ID (vla-get-handle ENTDBX))
       (setq VOBJ ENTDBX)
    )
             )
         )
         (setq MATRIX (caddr ENT))
         (setq
             COPYOBJ
               (car
     (vlax-invoke
         DBXDOC
         'COPYOBJECTS
         (list VOBJ)
         (if
             (or (= (getvar "TILEMODE") 1)
       (> (getvar "CVPORT") 1)
             )
               (vla-get-modelspace DOC)
               (vla-get-paperspace DOC)
         )
     )
               )
         )
         (vla-transformby COPYOBJ (vlax-tmatrix MATRIX))
         (ssadd (entlast) SS_DEL)
       )
   )   (vla-highlight COPYOBJ :vlax-true)
             )
         )
   )
   (command "")   (while (/= (sslength SS) 0)
       (setq ENT1 (ssname SS 0))
       (if  (= (cdr (assoc 0 (entget ENT1))) "INSERT")
           (setq LAYLIST
           (foreach ITEM (ISOBLKLAY (ssname SS 0))
               (setq LAYLIST (cons ITEM LAYLIST))
           )
           )
           (progn
  (setq LAY (cdr (assoc 8 (entget (ssname SS 0)))))
  (if (not (member LAY LAYLIST))
     (setq LAYLIST (cons LAY LAYLIST))
  ) ;_ if
           )
       )
       (ssdel (ssname SS 0) SS)
   )
   ;; if layers found, isolate layers
   (if LAYLIST
       (progn
           (vlax-for  LAY LAYERS
  (if (not (member (vla-get-name LAY) LAYLIST))
     ;; turn off layers not in block
     (vla-put-layeron LAY :vlax-false)
     ;; turn on layers in block
     (vla-put-layeron LAY :vlax-true)
  ) ;_ if
           ) ;_ vlax-for
       ) ;_progn
   ) ;_ if   (command "_.erase" SS_DEL "")
   (setq *ERROR* OLDERR)
   (vla-endundomark DOC) ;_ vla-endundomark
   (vlax-release-object DOC)
   (vlax-release-object LAYERS)
   (vlax-release-object MSPACE)
   (vlax-release-object DBXDOC)
   (setvar "cmdecho" HOLDECHO)
   (princ)
) ;_ defun

无痕 · 发表于 2004-11-5 21:44:00

阿龙能否详细说说功能？

我试了一下，选中外部参照中任何一个实体，最后结果都是显示所有同一个外部参照的所有图层实体，和本图同名层实体，关闭其它图层，是这样么？

citykunan · 发表于 2004-11-8 10:47:00

对于XREF我很有兴趣的，但是为什么我不能运行？ Command: SSISOBLK
Error: Automation Error. Problem in loading applicationUnknown command
"SSISOBLK". Press F1 for help.

龙龙仔 · 发表于 2004-11-8 10:51:00

无痕:你没有看清楚贴子(有空再看一次)

Hello,
I've got two lisp routines that I've dreamed of combining. One routine is "Block Isolate.lsp" and the other is "Isolate_Xref_Layer.lsp".
Block Isolate is an awesome routine that will not only isolate the layer a block is inserted on, but also its nested layers. It also allows for a selection set.
Isolate_Xref_Layer will isolate a single layer in an xref (or elsewhere), but only one.
Would someone be willing to add the functionality of Isolate_Xref_Layer to Block Isolate? This dream routine would allow a selection set of objects that would also include xref layers.
A cool feature would be for the routine to do the same thing with xreffed blocks that Block Isolate does - that is to display all the nested layers of the block as well as its insertion layer.
I've tried using two books on lisp to understand Block Isolate so as to be able to write the routine; but I'm still a total rookie when it comes to lisp, etc.
I'd really appreciate some help. If I have to pay someone, so be it.
Thanks,
Jamie

那老外要求点选blk可孤立显示图层但又希望能单选孤立显示图层,所以程序分为2次选物件

龙龙仔 · 发表于 2004-11-8 10:56:00

;;把这段改一下,可能你用r2005以下版本,所以ObjectDBX没有註册
;;------------------------------------------------------
(if (> (atoi (getvar "AcadVer")) 15)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.16"
)
)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument"
)
)
) ;;-------------------------------------------------------
(if (> (atoi (getvar "AcadVer")) 15)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.16"
)
)
(progn
(if (not (vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
)
)
(startapp "regsvr32.exe"
(strcat "/s \"" (findfile "axdb15.dll") "\"")
)
)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument"
)
)
)
)

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

[分享]有關點選亮顯xref內物件的貼子

评分