|
(defun Makeblock (Obj Insert / Count)
(entmake (list'(0 . "BLOCK") '(2 . "*U") '(70 . 1) '(10 0.0 0.0 0.0)))
(if (not LastObj)
(entmake Obj)
(entmake (entget LastObj))
);end if
(setq BlockName (entmake '((0 . "ENDBLK"))))
(entmake
(list'(0 . "INSERT") (cons 2 BlockName) (cons 10 (dxf 10 Insert))
(cons 50 (Dxf 50 Insert)) (cons 41 (dxf 41 Insert))
(cons 42 (dxf 42 Insert)) (cons 43 (dxf 43 Insert))
)
)
(command "_.explode" (entlast))
(if(> (sslength (ssget "_P")) 1)
(command "_.pedit" (entlast) "_y" "_j" (ssget "_P") "" "")
)
(setq LastObj (entlast))
(command "_.purge" "_b" BlockName "_y" "_y")
);end Makeblock
(defun CopyElem (Old / New LtName Color)
(setq LtName (Dxf 6 (setq New (vl-remove (assoc 5 Old) Old)))
Color (Dxf 62 New)
)
(if(= (Dxf 0 New) "ATTRIB") (setq New (At2Txt New)))
(cond
((= (length Elem) 2)
(CreateObject T)
)
((not (FindPath)) (CreateObject nil))
(T (setq New (subst (cons 8 (getvar "clayer")) (assoc 8 New) New)
ObjDbx (vla-getInterfaceObject (vlax-get-acad-object)
"ObjectDBX.AxDbDocument")
)
(vla-open ObjDbx (FindPath))
(setq LayerDbx (VLAObj (TakeName (Dxf 8 Old)) (vla-get-layers ObjDbx)))
(cond
((not LtName) (setq LtName (vla-get-linetype LayerDbx))
)
(T (setq LtName (TakeName LtName))
)
)
(if (not Color) (setq New (append New (list (cons 62 (vla-get-color LayerDbx))))))
(if (assoc 6 New)
(setq New (subst (cons 6 LtName) (assoc 6 New) New))
(setq New (append New (list (cons 6 LtName))))
)
(if (not (member (strcase LtName) (LtypeList)))
(CopyLtype LtName)
)
(foreach Item (last Elem)
(MakeBlock New (entget Item))
)
)
)
(if Global
(ssadd LastObj Global)
(setq Global (ssadd LastObj))
)
(redraw LastObj 3)
(setq LastObj nil)
);end CopyElem
(defun TakeName (Name)
(if (wcmatch Name "*|*")
(cond
((= (substr Name 1 1) "|") (substr Name 2))
(T (TakeName (substr Name 2)))
)
Name
)
);end TakeName
(defun LtypeList (/ Out)
(vlax-for Each (vla-get-linetypes (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (snvalid (vla-get-Name Each))
(setq Out (cons (vla-get-Name Each) Out))
)
)
(mapcar 'strcase (acad_strlsort Out))
);end LtypeList
(defun VLAObj (Name Obj / Out)
(vlax-for Item Obj
(if (= (strcase (vla-get-Name Item)) (strcase Name))
(setq Out Item)
)
)
Out
);end VLAObj
(defun CheckLockLayer (NLayer)
(equal 4
(logand 4
(cdr (assoc 70
(entget (tblobjname "layer" NLayer))
))
)
)
);end CheckLockLayer
(defun Dxf (Index Value)
(cdr (assoc Index Value))
);end Dxf
(defun At2Txt (Atr / Obj)
(setq Obj '((0 . "TEXT")))
(foreach Item '(8 6 38 39 62 67 210 10 40 1 50 41 51 7 71 72 73 11)
(if (assoc Item Atr)
(setq Obj (cons (assoc Item Atr) Obj))
)
)
(setq Obj (subst (cons 73 (cdr (assoc 74 Atr))) (assoc 72 Obj) Obj))
(reverse Obj)
);end At2Txt
(defun FindPath (/ Objs Path)
(setq Objs (last Elem))
(while (and Objs (not Path))
(setq Path
(cdr
(assoc 1
(tblsearch "BLOCK"
(Dxf 2 (entget (car Objs)))
)
)
)
)
(setq Objs (cdr Objs))
);end while
(if (and Path (not (setq Path (findfile Path))))
(setq Path (findfile (strcat (vl-filename-base Path) ".dwg")))
)
Path
);end FindPath
(defun CopyLtype (Name)
(vla-CopyObjects
ObjDbx
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
'(0 . 0)
)
(list (VLAObj Name (vla-get-linetypes ObjDbx)))
)
(vla-get-linetypes (vla-get-ActiveDocument (vlax-get-acad-object)))
)
);end CopyLtype
(defun c:bcopy (/ OldVars Olderr LockLayer Elem LastObj Global ObjDbx LayerDbx)
(vl-load-com)
(setq OldVars (mapcar 'getvar '("cmdecho" "highlight" "explmode")))
(mapcar 'setvar '("cmdecho" "highlight" "explmode") '(0 1 1))
(setq Olderr *error* *error* LispError)
(command "_.undo" "_be")
(if (setq LockLayer (CheckLockLayer (getvar "clayer")))
(command "_.-layer" "_unlock" (getvar "clayer") "")
)
(while (setq Elem (nentsel "\n选择图元: "))
(CopyElem (entget (car Elem)))
);end while
(if Global
(progn
(prompt "\n选择基点和位移: ")
(command "_.move" Global ""
(while (not (zerop (getvar "cmdactive")))(command pause))
)
)
)
(if LockLayer (command "_.-layer" "_lock" (getvar "clayer") ""))
(command "_.undo" "_end")
(setq *error* Olderr)
(mapcar 'setvar '("cmdecho" "highlight" "explmode") OldVars)
(princ)
);end file
(prompt "\n完成。 ")
(princ)
|