CAD Fórum : spojení části půdorysu do bloku

CleanXdata napsal(a):

;;;----------------------------------- ---------------------- C:CleanXdata ----------
(defun C:CleanXdata ( / allnames)
(vl-load-com)
(setq allnames nil)
(vlax-for obj (vla-get-RegisteredApplications(vla-get-activedocument (vlax-get-acad-object)))
(if (vlax-property-available-p obj 'Name)
(setq allnames (cons (vla-get-name obj) allnames))
))
(setq allnames (mapcar '(lambda(x)(cons x (if (and (/= x "ACAD")(ssget "x" (list (list -3 (list x))))) 1 0)))(reverse allnames)))
(if (setq allnames (dos_checklist "CleanXdata" "Choose appication(s) to clean" allnames))
(Cxd:DDP_del_all_prm (vl-remove nil (mapcar '(lambda(x)(if (= (cdr x) 1) (car x))) allnames)))
)
(princ)
)
; thanks to Jurge Menzi and Tony Tanzillo
; Use:
; (DDP_del_all_prm '("MyApp1" "MyApp2")) ;delete by AppID's
; or
; (Cxd:DDP_del_all_prm '("*")) ;delete all
; (Cxd:DDP_del_all_prm '("AcDbBlockRepETag"))
; The argument of the function should be a list. This allows you to
; delete Xdata's with different AppID's.
;------------------------------------------------ DDP_del_all_prm --------------
(defun Cxd:DDP_del_all_prm (Apps / apps_str CurEnt CurSet ncurSet i loopmax EntCnt appNames)
(setq apps_str (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) Apps)))
(cond
((setq CurSet (ssget (list (list -3 (list apps_str)))))
(setq ncurSet (sslength CurSet) i 0 loopmax 500)
(if (> ncurSet loopmax)(dos_getprogress "Cleaning data." (strcat "Cleaning data from " (itoa ncurSet) " entities. Wait...") ncurSet))
(repeat ncurSet
(if (> ncurSet loopmax)(dos_getprogress -1))
(setq CurEnt (ssname CurSet i) i (1+ i))
(setq appNames (if (and (setq appName (DelXdata CurEnt Apps))(not (member appName appNames))) (cons appName appNames) appNames))
(if (= "INSERT" (dxf 0 (entget CurEnt)))
(while (= "ATTRIB" (dxf 0 (entget (setq CurEnt (entnext CurEnt)))))
(setq appNames (if (and (setq appName (DelXdata CurEnt Apps))(not (member appName appNames))) (cons appName appNames) appNames))
)
)
) ;repeat
(if (> ncurSet loopmax)(dos_getprogress T))
(princ (strcat"\nDeleting Xdata from "(itoa ncurSet)" entities \nWith ApplicationName(s) "
(if appNames (apply 'strcat (mapcar '(lambda(x)(strcat x ","))appNames)) "")))
)
(T (princ (strcat "\nNot Xdata found for ApplicationName(s) " apps_str)))
)
(princ)
)
;------------------------------------------------ DelXdata --------------
; hulpfunctie voor deleting xdata
(defun DelXdata (Ent Apps / EntLst TmpLst appName)
(setq EntLst (entget Ent Apps) appName (caar (dxf -3 EntLst)))
(if (and (eq "DIMENSION" (dxf 0 EntLst))(not (dxf -3 (entget Ent '("ACAD"))))(= 14 (atoi (getvar "ACADVER"))))
(entmod (list (cons -1 Ent) (cons -3 '(("ACAD" (1000 . "DSTYLE"))))))
)
(foreach memb (dxf -3 EntLst)
(setq TmpLst (cons -3 (list (cons (car memb) nil)))
EntLst (entmod (subst TmpLst (assoc -3 EntLst) EntLst))
)
)
(entmod (vl-remove (assoc -3 EntLst) EntLst))
appName
)

;------------------------------------------------ DXF --------------
(defun DXF (code elist)
(cdr (assoc code elist))
)