Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/26/2025 in all areas

  1. without the actual drawings unable to test this so this is untested : (defun c:BatchXref ( / skipList folder curPhase prevPhases phaseList ) (setq skipList '("X-TTLB.dwg" "X-DETL.dwg" "X-LGND.dwg")) (setq folder (GetShellFolder "Select target folder")) ;;; Prompt for current phase number (setq curPhase (getstring "\nEnter current phase number (e.g., 03): ")) ;;; Prompt for previous phase numbers (setq prevPhases (getstring "\nEnter previous phase numbers (comma-separated, e.g., 01,02): ")) ;;; split up previous phases (setq phaseList (SplitStr prevPhases ",")) ;; Display phase info (princ (strcat "\nCurrent Phase: X-BASE-UN" curPhase)) (princ (strcat "\nPrevious Phases: " (apply 'strcat (mapcar (function (lambda (p) (strcat " " p))) phaseList)))) ;;; Create X-REF layer if needed (if (not (tblsearch "LAYER" "X-REF")) (command "_.-LAYER" "_Make" "X-REF" "_Color" "7" "X-REF" "")) ;;; Get DWG files (if (vl-consp (setq files (vl-directory-files folder "*.dwg" 1))) (progn ;;; Insert XREFs (foreach file files (if (not (member (strcase file) (mapcar 'strcase skipList))) (progn (setq fullpath (strcat folder file)) (command "_.-XREF" "_Overlay" fullpath '(0 0 0) 1 1 0) (command "_.CHPROP" "L" "" "_LA" "X-REF" "") ) ) ) ;;; Lock the layer (command "_.-LAYER" "_Lock" "X-REF" "") ;;; Change color of layers with previous phase names in XREF or nested XREF (setq layerTable (tblnext "LAYER" T)) (while layerTable (setq layerName (cdr (assoc 2 layerTable))) (setq matched nil) ;;; *** vl-string-split *** made up by glorified paperclip ;;; Split layer name into parts (XREF nesting) (setq xrefParts (SplitStr layerName "|")) ;;; Check each part for a match with previous phase names (foreach part xrefParts (if (member (strcase part) phaseList) (setq matched T))) ;;; If matched, change layer color using entmod (if matched (progn (setq layerEnt (tblobjname "LAYER" layerName)) (if layerEnt (progn (setq layerData (entget layerEnt)) (if (assoc 62 layerData) (setq layerData (subst (cons 62 251) (assoc 62 layerData) layerData)) (setq layerData (append layerData (list (cons 62 251)))) ) (entmod layerData) (entupd layerEnt) ) ) ) ) (setq layerTable (tblnext "LAYER")) ) (princ "\nOverlay XREFs added. Layers in matching XREFs and nested XREFs set to color 251.") ) (princ "\nNo folder selected / files to proces") ) (princ) ) ;;; s = string d = delimiter p = position delimiter (setq r (SplitStr "01,02" ",")) -> '("01" "02") (defun SplitStr ( s d / p ) (if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s))) ;;; (setq f (GetShellFolder "Select a folder")) -> "C:\\Temp\\Lisp\\" (defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\"))) Just a couple remarks : getfolder (or GetShellFolder) is more generic than selecting a drawing and stripping out path. It's not wrong but soooo last century. ChatGPT or Copilot : stop using them and learn to do it yourself. As long as those glorified paperclips are not star-trek level you can't trust them. They make up commands like in your code : (setq xrefParts (vl-string-split layerName "|")) , maybe somebody at one time created this (vl-string-split) as a custom defun but in my visual lisp editor it didn't turn blue so its not a core command. I replaced it with SplitStr. Oh I also don't see a save command anywhere so I assume that's handled by you or Copilot? I hope code above works , if not... bite me
    1 point
  2. Don't have express tools loaded right now. But this should do what you want. Burst blocks with attributes and explode blocks that don't. Until their aren't any blocks left. If burst isn't loaded it would loop forever so added a if statement to check for burst command. ;;----------------------------------------------------------------------------;; ;; Explode all Blocks in drawing (defun C:EB (/ SS) (vl-load-com) (if (vl-symbol-value 'C:Burst) ;test for burst command (while (setq SS (ssget "_X" '((0 . "INSERT") (410 . "Model")))) (foreach e (mapcar 'cadr (ssnamex SS)) (if (assoc 66 (entget e)) (vl-cmdf "_.Burst" e "") (progn (vla-explode (setq blk (vlax-ename->vla-object e))) (vla-delete blk) ) ) ) ) (prompt "\nPlease Load Burst Command before running \"EB\" Command") ) (princ) )
    1 point
×
×
  • Create New...