Code & Scripts
COPYBLOCKTOALLCLOSED v07 working.lsp
This LISP routine automates the placement of a selected AutoCAD block (including its attributes) into the approximate centroid of all closed polylines that reside on a user-defined layer. It's useful for quickly populating drawings with standard elements within enclosed areas.
(defun c:COPYBLOCKTOALLCLOSED ( / selBlock blockName blockAttribs blkLayer blkScale polySel polyLayer ss i ent entObj pt newBlk)
(vl-load-com)
;; Helper: Get block attributes
(defun GetBlockAttributes (blk / result)
(setq result '())
(if blk
(foreach att (vlax-invoke (vlax-ename->vla-object blk) 'GetAttributes)
(setq result (cons (list (vla-get-TagString att) (vla-get-TextString att)) result))
)
)
result
)
;; NEW HELPER: Get the approximate centroid of a polyline
(defun GetPolylineCentroid (pline_obj / coords num_verts i sum_x sum_y)
(setq coords (vlax-get pline_obj 'Coordinates)
num_verts (/ (length coords) 2)
i 0
sum_x 0.0
sum_y 0.0
)
(repeat num_verts
(setq sum_x (+ sum_x (nth i coords))
sum_y (+ sum_y (nth (1+ i) coords))
i (+ i 2)
)
)
(list (/ sum_x num_verts) (/ sum_y num_verts) 0.0)
)
;; Ask user to select the source block
(prompt "\n📌 Select the source block reference (with attributes): ")
(setq selBlock (car (entsel "\nSelect block: ")))
(if (not selBlock)
(progn (prompt "\n⚠️ No block selected. Exiting.") (exit))
)
;; Validate block type
(if (/= (cdr (assoc 0 (entget selBlock))) "INSERT")
(progn (prompt "\n❌ That is not a block. Exiting.") (exit))
)
;; Extract block details
(setq blockName (cdr (assoc 2 (entget selBlock))))
(setq blockAttribs (GetBlockAttributes selBlock))
(setq blkLayer (cdr (assoc 8 (entget selBlock))))
(setq blkScale (cdr (assoc 41 (entget selBlock)))) ; assume uniform scale
;; Ask user to select a sample polyline
(prompt "\n📌 Select one closed polyline to define the target layer: ")
(setq polySel (car (entsel "\nSelect closed polyline: ")))
(if (not polySel)
(progn (prompt "\n⚠️ No polyline selected. Exiting.") (exit))
)
;; Check it's a closed LWPOLYLINE
(if (or (/= (cdr (assoc 0 (entget polySel))) "LWPOLYLINE")
(/= 1 (logand (cdr (assoc 70 (entget polySel))) 1)))
(progn (prompt "\n❌ That is not a closed LWPOLYLINE. Exiting.") (exit))
)
;; Get polyline layer
(setq polyLayer (cdr (assoc 8 (entget polySel))))
;; Select all closed polylines on the same layer
(setq ss (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 polyLayer) (cons -4 ""))))
(if (not ss)
(progn (prompt "\n⚠️ No matching closed polylines found. Exiting.") (exit))
)
;; Start placing blocks
(prompt (strcat "\n🔁 Inserting block \"" blockName "\" into closed polylines..."))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq entObj (vlax-ename->vla-object ent))
(if (= (vla-get-Closed entObj) :vlax-true)
(progn
;; ***MODIFIED LINE***: Use the new centroid function instead of the midpoint of the perimeter
(setq pt (GetPolylineCentroid entObj))
;; Insert block
(setq newBlk (vla-InsertBlock
(vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-3d-point pt)
blockName
blkScale blkScale blkScale
0.0))
;; Match source layer
(vla-put-Layer newBlk blkLayer)
;; Copy attributes
(if newBlk
(if blockAttribs
(foreach att (vlax-invoke newBlk 'GetAttributes)
(foreach attrPair blockAttribs
(if (= (vla-get-TagString att) (car attrPair))
(vla-put-TextString att (cadr attrPair))
)
)
)
)
)
)
)
(setq i (1+ i))
)
(prompt "\n✅ DONE: Blocks inserted into the center of all closed polylines.")
(princ)
)
FULL-UPDATE.lsp
This LISP routine performs a full update process on an AutoCAD drawing. It automates the updating of block attributes (like UnitNumber and FloorNumber) within defined unit and floor polylines. This script is designed to streamline the management of drawing data, ensuring consistency across various details such as spaces, doors, and windows.
(defun c:FULL-UPDATE ( / *error* adoc allUnitPolylines allFloorPolylines i total)
(defun *error* (msg)
(if adoc (vla-endundomark adoc))
(if (not (wcmatch (strcase msg) "*QUIT*,*CANCEL*")) (princ (strcat "\nError: " msg)))
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(princ "\n--- STARTING FULL UPDATE PROCESS ---")
;; 1. Run Unit Updates
(princ "\n\n--- Step 1: Processing all unit boundaries ---")
(setq allUnitPolylines (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Unit") (-4 . "&") (70 . 1))))
(if allUnitPolylines
(progn
(setq total (sslength allUnitPolylines))
(princ (strcat "\nFound " (itoa total) " unit boundaries."))
(setq i 0)
(repeat total
(process-unit-polyline (ssname allUnitPolylines i))
(setq i (1+ i))
)
)
(princ "\nNo unit boundaries found on layer 'Unit'.")
)
;; 2. Run Floor Updates
(princ "\n\n--- Step 2: Processing all floor boundaries ---")
(setq allFloorPolylines (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Floor") (-4 . "&") (70 . 1))))
(if allFloorPolylines
(progn
(setq total (sslength allFloorPolylines))
(princ (strcat "\nFound " (itoa total) " floor boundaries."))
(setq i 0)
(repeat total
(process-floor-polyline (ssname allFloorPolylines i))
(setq i (1+ i))
)
)
(princ "\nNo floor boundaries found on layer 'Floor'.")
)
(princ "\n\n--- FULL UPDATE PROCESS COMPLETE ---")
(vla-endundomark adoc)
(princ)
)
(princ "\nLoaded FULL-UPDATE command.")
(princ)
MASTER-COMMAND-ENHANCED.lsp
This is an enhanced master LISP command for AutoCAD that offers a comprehensive suite of tools for managing and analyzing drawing data. It features an interactive menu allowing users to perform operations such as updating unit and floor details, synchronizing block attributes (e.g., for doors and windows with spaces), calculating net areas, and analyzing/modifying door-space relationships. This script significantly streamlines complex architectural and spatial data management workflows.
(vl-load-com)
;;;-------------------------------------------------------------------
;;; COMMON HELPER FUNCTIONS
;;;-------------------------------------------------------------------
(defun get-attribute-value (block-obj tag-name / result)
(setq tag-name (strcase tag-name))
(setq result (vl-some ' (lambda (att)
(if (= (strcase (vla-get-tagstring att)) tag-name)
(vla-get-textstring att)
)
)
(vlax-invoke block-obj 'GetAttributes)
))
;; Ensure we always return a string or nil
(if (and result (= (type result) 'STR))
result
nil
)
)
(defun set-attribute-value (block-obj tag-name new-value)
(setq tag-name (strcase tag-name))
(foreach att (vlax-invoke block-obj 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) tag-name)
(vla-put-textstring att new-value)
)
)
)
(defun get-polyline-vertices (pline-ent)
(mapcar 'cdr (vl-remove-if-not ' (lambda (x) (= (car x) 10)) (entget pline-ent)))
)
(defun get-all-block-attributes (block-obj / attribs result)
"Returns a list of all attribute tag-value pairs for a block"
(setq attribs (vlax-invoke block-obj 'GetAttributes))
(setq result nil)
(foreach att attribs
(setq result (cons (list (vla-get-TagString att) (vla-get-TextString att)) result))
)
result
)
;;;-------------------------------------------------------------------
;;; RELATIONSHIP ANALYSIS FUNCTIONS
;;;-------------------------------------------------------------------
(defun analyze-door-space-relationships ( / all-doors all-spaces door-relationships i j door-ent door-vlist door-handle door-detail-set door-material door-type door-detail-obj space-ent space-vlist space-detail-set space-detail-obj space-usage space-num unit-num floor-num connected-spaces)
"Analyzes relationships between doors and spaces"
(princ "\n\n=== DOOR-SPACE RELATIONSHIP ANALYSIS ===")
(setq all-doors (ssget "_X" '((0 . "LWPOLYLINE") (8 . "door") (-4 . "&") (70 . 1))))
(setq all-spaces (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Space") (-4 . "&") (70 . 1))))
(setq door-relationships nil)
(if (and all-doors all-spaces)
(progn
(princ (strcat "\nFound " (itoa (sslength all-doors)) " doors and " (itoa (sslength all-spaces)) " spaces."))
(setq i 0)
(repeat (sslength all-doors)
(setq door-ent (ssname all-doors i))
(setq door-vlist (get-polyline-vertices door-ent))
(setq door-handle (vla-get-handle (vlax-ename->vla-object door-ent)))
;; Find door detail block and get material info
(setq door-detail-set (ssget "_CP" door-vlist '((0 . "INSERT") (2 . "DoorDetail"))))
(setq door-material "Unknown")
(setq door-type "Unknown")
(if (and door-detail-set (= 1 (sslength door-detail-set)))
(progn
(setq door-detail-obj (vlax-ename->vla-object (ssname door-detail-set 0)))
(setq door-material (or (get-attribute-value door-detail-obj "MATERIAL")
(get-attribute-value door-detail-obj "DOORTYPE")
(get-attribute-value door-detail-obj "TYPE")
"Not Specified"))
(setq door-type (or (get-attribute-value door-detail-obj "DOORTYPE")
(get-attribute-value door-detail-obj "TYPE")
"Standard"))
;; Ensure door-material and door-type are always strings
(if (not (= (type door-material) 'STR)) (setq door-material "Not Specified"))
(if (not (= (type door-type) 'STR)) (setq door-type "Standard"))
)
)
;; Find connected spaces
(setq connected-spaces nil)
(setq j 0)
(repeat (sslength all-spaces)
(setq space-ent (ssname all-spaces j))
(setq space-vlist (get-polyline-vertices space-ent))
(if (polylines-share-vertex-p door-vlist space-vlist)
(progn
;; Get space details
(setq space-detail-set (ssget "_CP" space-vlist '((0 . "INSERT") (2 . "SpaceDetail"))))
(if (and space-detail-set (= 1 (sslength space-detail-set)))
(progn
(setq space-detail-obj (vlax-ename->vla-object (ssname space-detail-set 0)))
(setq space-usage (or (get-attribute-value space-detail-obj "SPACEUSAGE") "Unknown"))
(setq space-num (or (get-attribute-value space-detail-obj "SPACENUMBER") "?"))
(setq unit-num (or (get-attribute-value space-detail-obj "UNITNUMBER") "?"))
(setq floor-num (or (get-attribute-value space-detail-obj "FLOORNUMBER") "?"))
;; Ensure all values are strings
(if (not (= (type space-usage) 'STR)) (setq space-usage "Unknown"))
(if (not (= (type space-num) 'STR)) (setq space-num "?"))
(if (not (= (type unit-num) 'STR)) (setq unit-num "?"))
(if (not (= (type floor-num) 'STR)) (setq floor-num "?"))
(setq connected-spaces (cons (list space-usage space-num unit-num floor-num) connected-spaces))
)
)
)
)
(setq j (1+ j))
)
;; Store relationship data
(setq door-relationships (cons (list door-handle door-material door-type connected-spaces) door-relationships))
;; Print relationship info
(princ (strcat "\n\nDoor " (if door-handle door-handle "Unknown") ":"))
(princ (strcat "\n Material/Type: " (if door-material door-material "Unknown") " (" (if door-type door-type "Unknown") ")"))
(princ (strcat "\n Connected to " (itoa (length connected-spaces)) " spaces:"))
(foreach space-info connected-spaces
(if (and space-info (>= (length space-info) 4))
(princ (strcat "\n - " (if (car space-info) (car space-info) "Unknown") " (Space:" (if (cadr space-info) (cadr space-info) "?")
", Unit:" (if (caddr space-info) (caddr space-info) "?") ", Floor:" (if (cadddr space-info) (cadddr space-info) "?") ")"))
(princ "\n - Invalid space data")
)
)
(setq i (1+ i))
)
)
(princ "\nNo doors or spaces found for analysis.")
)
door-relationships
)
(defun auto-set-door-materials-by-space (door-relationships / door-info door-handle connected-spaces space-info space-usage door-ent door-vlist door-detail-set door-detail-obj material-to-set updatedCount)
"Automatically sets door materials based on connected space types"
(if door-relationships
(progn
(princ "\n\n=== AUTOMATIC DOOR MATERIAL ASSIGNMENT ===")
(setq updatedCount 0)
(foreach door-info door-relationships
(setq door-handle (car door-info))
(setq connected-spaces (cadddr door-info))
(setq material-to-set nil)
;; Check space types and determine material
(foreach space-info connected-spaces
(setq space-usage (car space-info))
;; Ensure space-usage is a string before using strcase
(if (and space-usage (= (type space-usage) 'STR))
(progn
(setq space-usage (strcase space-usage))
(cond
;; Lift doors should be Steel
((wcmatch space-usage "*LIFT*,*ELEVATOR*")
(setq material-to-set "Steel")
)
;; Balcony doors should be Aluminum
((wcmatch space-usage "*BALCONY*,*TERRACE*")
(setq material-to-set "Aluminum")
)
;; Main entrance doors should be Steel
((wcmatch space-usage "*ENTRANCE*,*LOBBY*,*FOYER*")
(setq material-to-set "Steel")
)
;; Bathroom doors can be Wood (moisture resistant)
((wcmatch space-usage "*BATH*,*WC*,*W.C*,*TOILET*")
(if (not material-to-set) (setq material-to-set "Wood"))
)
)
)
)
)
;; Update door material if determined
(if material-to-set
(progn
(setq door-ent (handent door-handle))
(if door-ent
(progn
(setq door-vlist (get-polyline-vertices door-ent))
(setq door-detail-set (ssget "_CP" door-vlist '((0 . "INSERT") (2 . "DoorDetail"))))
(if (and door-detail-set (= 1 (sslength door-detail-set)))
(progn
(setq door-detail-obj (vlax-ename->vla-object (ssname door-detail-set 0)))
(set-attribute-value door-detail-obj "MATERIAL" material-to-set)
(set-attribute-value door-detail-obj "DOORTYPE" material-to-set)
(set-attribute-value door-detail-obj "TYPE" material-to-set)
(princ (strcat "\n Door " (if door-handle door-handle "Unknown") " -> " material-to-set " (connected to: "))
(foreach space-info connected-spaces
(if (and space-info (car space-info))
(princ (strcat (car space-info) " "))
)
)
(princ ")")
(setq updatedCount (1+ updatedCount))
)
)
)
)
)
)
)
(princ (strcat "\n\nAutomatically updated " (itoa updatedCount) " doors based on space types."))
)
)
)
(defun modify-door-materials (door-relationships / choice door-handle new-material door-info current-material door-type connected-spaces door-ent door-vlist door-detail-set door-detail-obj)
"Allows user to modify door materials based on analysis"
(if door-relationships
(progn
(princ "\n\n=== DOOR MATERIAL MODIFICATION ===")
(princ "\nOptions:")
(princ "\n1. Auto-assign materials based on space types")
(princ "\n2. Manual material assignment")
(princ "\n3. Skip material modification")
(princ "\nSelect option [1/2/3]: ")
(initget "1 2 3")
(setq choice (getkword))
(cond
((= choice "1")
(auto-set-door-materials-by-space door-relationships)
)
((= choice "2")
(princ "\n\n=== MANUAL DOOR MATERIAL ASSIGNMENT ===")
(foreach door-info door-relationships
(setq door-handle (car door-info))
(setq current-material (cadr door-info))
(setq door-type (caddr door-info))
(setq connected-spaces (cadddr door-info))
(princ (strcat "\n\nDoor " (if door-handle door-handle "Unknown") " (Current: " (if current-material current-material "Unknown") ")"))
(princ "\nConnected spaces: ")
(foreach space-info connected-spaces
(if (and space-info (car space-info))
(princ (strcat (car space-info) " "))
)
)
(princ "\nChange material? [Wood/Steel/Aluminum/Glass/Skip]: ")
(initget "Wood Steel Aluminum Glass Skip")
(setq new-material (getkword))
(if (and new-material (not (= new-material "Skip")))
(progn
;; Find and update the door detail block
(setq door-ent (handent door-handle))
(if door-ent
(progn
(setq door-vlist (get-polyline-vertices door-ent))
(setq door-detail-set (ssget "_CP" door-vlist '((0 . "INSERT") (2 . "DoorDetail"))))
(if (and door-detail-set (= 1 (sslength door-detail-set)))
(progn
(setq door-detail-obj (vlax-ename->vla-object (ssname door-detail-set 0)))
;; Try different possible attribute names for material
(set-attribute-value door-detail-obj "MATERIAL" new-material)
(set-attribute-value door-detail-obj "DOORTYPE" new-material)
(set-attribute-value door-detail-obj "TYPE" new-material)
(princ (strcat "\n Updated door material to: " new-material))
)
(princ "\n Warning: Could not find door detail block to update.")
)
)
(princ "\n Warning: Could not find door entity.")
)
)
)
)
)
((= choice "3")
(princ "\nSkipping material modification.")
)
)
)
)
)
(defun polylines-share-vertex-p (pline1-vlist pline2-vlist / found)
(setq found nil)
(foreach v1 pline1-vlist
(if (not found)
(foreach v2 pline2-vlist
(if (equal v1 v2 1e-6)
(setq found T)
)
)
)
)
found
)
;;;-------------------------------------------------------------------
;;; ORIGINAL FUNCTIONS (with minor modifications)
;;;-------------------------------------------------------------------
(defun update-unit-child-attributes (blockName vertices floorNum unitNum / detailSet i detailObj detailAttribs attrib)
(setq detailSet (ssget "_CP" vertices (list '(0 . "INSERT") (cons 2 blockName))))
(if detailSet
(progn
(princ (strcat "\n - Updating " (itoa (sslength detailSet)) " '" blockName "' blocks..."))
(setq i 0)
(repeat (sslength detailSet)
(setq detailObj (vlax-ename->vla-object (ssname detailSet i)))
(setq detailAttribs (vlax-invoke detailObj 'GetAttributes))
(foreach attrib detailAttribs
(cond
((= (strcase (vla-get-tagstring attrib)) "UNITNUMBER") (vla-put-textstring attrib unitNum))
((= (strcase (vla-get-tagstring attrib)) "FLOORNUMBER") (vla-put-textstring attrib floorNum))
)
)
(setq i (1+ i))
)
)
)
)
(defun process-unit-polyline (polyline / vertices unitDetailSet unitDetailObj unitAttribs floorNumVal unitNumVal)
(princ (strcat "\n - Processing unit boundary: " (vla-get-handle (vlax-ename->vla-object polyline))))
(setq vertices (get-polyline-vertices polyline))
(if (not vertices)
(princ "\n - Warning: Could not get vertices. Skipping.")
(progn
(setq unitDetailSet (ssget "_CP" vertices '((0 . "INSERT") (2 . "UnitDetail"))))
(cond
((not unitDetailSet) (princ "\n - Warning: No 'UnitDetail' block found. Skipping."))
((> (sslength unitDetailSet) 1) (princ "\n - Warning: Multiple 'UnitDetail' blocks found. Skipping."))
(t
(setq unitDetailObj (vlax-ename->vla-object (ssname unitDetailSet 0)))
(setq unitAttribs (vlax-invoke unitDetailObj 'GetAttributes))
(foreach attrib unitAttribs
(cond
((= (strcase (vla-get-tagstring attrib)) "UNITNUMBER") (setq unitNumVal (vla-get-textstring attrib)))
((= (strcase (vla-get-tagstring attrib)) "FLOORNUMBER") (setq floorNumVal (vla-get-textstring attrib)))
)
)
(if (or (not unitNumVal) (not floorNumVal))
(princ "\n - Warning: UNIT/FLOOR attributes not found in UnitDetail. Skipping.")
(progn
(princ (strcat "\n - Found UnitDetail. Floor: " floorNumVal " | Unit: " unitNumVal))
(update-unit-child-attributes "SpaceDetail" vertices floorNumVal unitNumVal)
(update-unit-child-attributes "DoorDetail" vertices floorNumVal unitNumVal)
(update-unit-child-attributes "WindowDetail" vertices floorNumVal unitNumVal)
)
)
)
)
)
)
)
(defun update-floor-child-attributes (blockName vertices floorNum / detailSet i detailObj detailAttribs attrib clearedCount updatedCount)
(setq detailSet (ssget "_CP" vertices (list '(0 . "INSERT") (cons 2 blockName))))
(if detailSet
(progn
(setq clearedCount 0)
(setq updatedCount 0)
(princ (strcat "\n - Processing " (itoa (sslength detailSet)) " '" blockName "' blocks..."))
(setq i 0)
(repeat (sslength detailSet)
(setq detailObj (vlax-ename->vla-object (ssname detailSet i)))
(setq detailAttribs (vlax-invoke detailObj 'GetAttributes))
(foreach attrib detailAttribs
(cond
((= (strcase (vla-get-tagstring attrib)) "FLOORNUMBER")
(vla-put-textstring attrib floorNum)
(setq updatedCount (1+ updatedCount))
)
((= (strcase (vla-get-tagstring attrib)) "UNITNUMBER")
(vla-put-textstring attrib "")
(setq clearedCount (1+ clearedCount))
)
)
)
(setq i (1+ i))
)
(if (> updatedCount 0)
(princ (strcat "\n - Updated FLOORNUMBER for " (itoa updatedCount) " blocks."))
)
(if (> clearedCount 0)
(princ (strcat "\n - Cleared UNITNUMBER for " (itoa clearedCount) " blocks."))
)
)
)
)
(defun process-floor-polyline (polyline / vertices floorDetailSet floorDetailObj floorAttribs floorNumVal)
(princ (strcat "\n - Processing floor boundary: " (vla-get-handle (vlax-ename->vla-object polyline))))
(setq vertices (get-polyline-vertices polyline))
(if (not vertices)
(princ "\n - Warning: Could not get vertices. Skipping.")
(progn
(setq floorDetailSet (ssget "_CP" vertices '((0 . "INSERT") (2 . "FloorDetail"))))
(cond
((not floorDetailSet) (princ "\n - Warning: No 'FloorDetail' block found. Skipping."))
((> (sslength floorDetailSet) 1) (princ "\n - Warning: Multiple 'FloorDetail' blocks found. Skipping."))
(t
(setq floorDetailObj (vlax-ename->vla-object (ssname floorDetailSet 0)))
(setq floorAttribs (vlax-invoke floorDetailObj 'GetAttributes))
(setq floorNumVal (get-attribute-value floorDetailObj "FLOORNUMBER"))
(if (not floorNumVal)
(princ "\n - Warning: FLOORNUMBER attribute not found in FloorDetail. Skipping.")
(progn
(princ (strcat "\n - Found FloorDetail. Floor: " floorNumVal))
(update-floor-child-attributes "SpaceDetail" vertices floorNumVal)
(update-floor-child-attributes "DoorDetail" vertices floorNumVal)
(update-floor-child-attributes "WindowDetail" vertices floorNumVal)
)
)
)
)
)
)
)
(defun process-building-outline (polyline / vertices ss count i blk att tag)
(princ (strcat "\n - Processing building outline: " (vla-get-handle (vlax-ename->vla-object polyline))))
(setq vertices (get-polyline-vertices polyline))
(if (not vertices)
(princ "\n - Warning: Could not get vertices. Skipping.")
(progn
(setq ss (ssget "_CP" vertices '((0 . "INSERT") (2 . "SpaceDetail") (66 . 1))))
(if ss
(progn
(setq count 1)
(setq i 0)
(princ (strcat "\n - Found " (itoa (sslength ss)) " 'SpaceDetail' blocks to renumber."))
(repeat (sslength ss)
(setq blk (vlax-ename->vla-object (ssname ss i)))
(foreach att (vlax-invoke blk 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (= tag "SPACENUMBER")
(progn
(vla-put-textstring att (itoa count))
(setq count (1+ count))
)
)
)
(setq i (1+ i))
)
(princ (strcat "\n - Successfully renumbered " (itoa (- count 1)) " blocks."))
)
(princ "\n - No 'SpaceDetail' blocks found within this outline.")
)
)
)
)
(defun update-detail-block-in-polyline (pline-ent block-name floor-num unit-num space-num / vertices detail-set detail-obj attribs)
(setq vertices (get-polyline-vertices pline-ent))
(if vertices
(progn
(setq detail-set (ssget "_CP" vertices (list '(0 . "INSERT") (cons 2 block-name))))
(if (and detail-set (= 1 (sslength detail-set)))
(progn
(setq detail-obj (vlax-ename->vla-object (ssname detail-set 0)))
(setq attribs (vlax-invoke detail-obj 'GetAttributes))
(foreach attrib attribs
(cond
((= (strcase (vla-get-tagstring attrib)) "FLOORNUMBER") (vla-put-textstring attrib floor-num))
((= (strcase (vla-get-tagstring attrib)) "UNITNUMBER") (vla-put-textstring attrib unit-num))
((= (strcase (vla-get-tagstring attrib)) "SPACENUMBER") (vla-put-textstring attrib space-num))
)
)
(princ (strcat "\n - Updated '" block-name "' in polyline: " (vla-get-handle (vlax-ename->vla-object pline-ent))))
)
(princ (strcat "\n - Warning: Found 0 or >1 '" block-name "' blocks in connected polyline. Skipping."))
)
)
)
)
;;;-------------------------------------------------------------------
;;; MAIN LOGIC FUNCTIONS WITH USER PROMPTS
;;;-------------------------------------------------------------------
(defun run-full-update-logic ( / allUnitPolylines allFloorPolylines i total allBuildingOutlines)
(princ "\n--- STARTING FULL UPDATE PROCESS ---")
(princ "\n\n--- Step 1: Processing all unit boundaries ---")
(setq allUnitPolylines (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Unit") (-4 . "&") (70 . 1))))
(if allUnitPolylines
(progn
(setq total (sslength allUnitPolylines))
(princ (strcat "\nFound " (itoa total) " unit boundaries."))
(setq i 0)
(repeat total
(process-unit-polyline (ssname allUnitPolylines i))
(setq i (1+ i))
)
)
(princ "\nNo unit boundaries found on layer 'Unit'.")
)
(princ "\n\n--- Step 2: Processing all floor boundaries ---")
(setq allFloorPolylines (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Floor") (-4 . "&") (70 . 1))))
(if allFloorPolylines
(progn
(setq total (sslength allFloorPolylines))
(princ (strcat "\nFound " (itoa total) " floor boundaries."))
(setq i 0)
(repeat total
(process-floor-polyline (ssname allFloorPolylines i))
(setq i (1+ i))
)
)
(princ "\nNo floor boundaries found on layer 'Floor'.")
)
(princ "\n\n--- Step 3: Renumbering spaces within building outlines ---")
(setq allBuildingOutlines (ssget "_X" '((0 . "LWPOLYLINE") (8 . "BuildingOutline") (-4 . "&") (70 . 1))))
(if allBuildingOutlines
(progn
(setq total (sslength allBuildingOutlines))
(princ (strcat "\nFound " (itoa total) " building outlines."))
(setq i 0)
(repeat total
(process-building-outline (ssname allBuildingOutlines i))
(setq i (1+ i))
)
)
(princ "\nNo building outlines found on layer 'BuildingOutline'.")
)
(princ "\n--- FULL UPDATE PROCESS COMPLETE ---")
)
(defun run-sync-logic ( / all-spaces all-doors all-windows i j space-ent space-vlist door-ent window-ent floor-val unit-val space-val space-detail-set space-detail-obj attrib)
(princ "\n\n--- STARTING DETAIL SYNCHRONIZATION ---")
(setq all-spaces (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Space") (-4 . "&") (70 . 1))))
(setq all-doors (ssget "_X" '((0 . "LWPOLYLINE") (8 . "door") (-4 . "&") (70 . 1))))
(setq all-windows (ssget "_X" '((0 . "LWPOLYLINE") (8 . "window") (-4 . "&") (70 . 1))))
(if all-spaces
(progn
(princ (strcat "\nFound " (itoa (sslength all-spaces)) " space boundaries to process."))
(setq i 0)
(repeat (sslength all-spaces)
(setq space-ent (ssname all-spaces i))
(princ (strcat "\n\n- Processing Space: " (vla-get-handle (vlax-ename->vla-object space-ent))))
;; Get SpaceDetail attributes
(setq space-vlist (get-polyline-vertices space-ent))
(setq space-detail-set (ssget "_CP" space-vlist '((0 . "INSERT") (2 . "SpaceDetail"))))
(if (and space-detail-set (= 1 (sslength space-detail-set)))
(progn
(setq space-detail-obj (vlax-ename->vla-object (ssname space-detail-set 0)))
(setq floor-val "" unit-val "" space-val "")
(foreach attrib (vlax-invoke space-detail-obj 'GetAttributes)
(cond
((= (strcase (vla-get-tagstring attrib)) "FLOORNUMBER") (setq floor-val (vla-get-textstring attrib)))
((= (strcase (vla-get-tagstring attrib)) "UNITNUMBER") (setq unit-val (vla-get-textstring attrib)))
((= (strcase (vla-get-tagstring attrib)) "SPACENUMBER") (setq space-val (vla-get-textstring attrib)))
)
)
(princ (strcat "\n - Found SpaceDetail. F:" floor-val " U:" unit-val " S:" space-val))
;; Find and update connected doors
(if all-doors
(progn
(setq j 0)
(repeat (sslength all-doors)
(setq door-ent (ssname all-doors j))
(if (polylines-share-vertex-p space-vlist (get-polyline-vertices door-ent))
(update-detail-block-in-polyline door-ent "DoorDetail" floor-val unit-val space-val)
)
(setq j (1+ j))
)
)
)
;; Find and update connected windows
(if all-windows
(progn
(setq j 0)
(repeat (sslength all-windows)
(setq window-ent (ssname all-windows j))
(if (polylines-share-vertex-p space-vlist (get-polyline-vertices window-ent))
(update-detail-block-in-polyline window-ent "WindowDetail" floor-val unit-val space-val)
)
(setq j (1+ j))
)
)
)
)
(princ "\n - Warning: Found 0 or >1 'SpaceDetail' blocks. Skipping space.")
)
(setq i (1+ i))
)
)
(princ "\nNo space boundaries found on layer 'Space'.")
)
(vla-endundomark adoc)
(princ "\n\n--- SYNCHRONIZATION COMPLETE ---")
(princ)
)
(defun run-calc-net-area-logic ( / all-units-ss i unit-ent unit-obj unit-area unit-vertices unit-detail-ss unit-detail-obj unit-num-val spaces-ss j space-ent space-obj space-vertices space-area space-detail-ss space-detail-obj space-usage bed-count bath-count total-deduction-area all-deductions-area void-shaft-area unit-classification duplex-level net-area)
(princ "\n\n--- STARTING NET AREA AND ROOM COUNT CALCULATION ---")
(setq all-units-ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Unit") (-4 . "&") (70 . 1))))
(if all-units-ss
(progn
(setq i 0)
(repeat (sslength all-units-ss)
(setq unit-ent (ssname all-units-ss i))
(setq unit-obj (vlax-ename->vla-object unit-ent))
(setq unit-area (vla-get-area unit-obj))
(setq unit-vertices (get-polyline-vertices unit-ent))
(princ (strcat "\n\nProcessing Unit: " (vla-get-handle (vlax-ename->vla-object unit-ent))))
(princ (strcat "\n - Gross Area: " (rtos unit-area)))
(setq total-deduction-area 0.0 all-deductions-area 0.0 void-shaft-area 0.0 bed-count 0 bath-count 0)
(setq unit-detail-ss (ssget "_CP" unit-vertices '((0 . "INSERT") (2 . "UnitDetail"))))
(if (and unit-detail-ss (= 1 (sslength unit-detail-ss)))
(progn
(setq unit-detail-obj (vlax-ename->vla-object (ssname unit-detail-ss 0)))
(setq unit-num-val (get-attribute-value unit-detail-obj "UNITNUMBER"))
(setq spaces-ss (ssget "_CP" unit-vertices '((0 . "LWPOLYLINE") (8 . "space"))))
(if spaces-ss
(progn
(setq j 0)
(repeat (sslength spaces-ss)
(setq space-ent (ssname spaces-ss j))
(setq space-obj (vlax-ename->vla-object space-ent))
(setq space-area (vla-get-area space-obj))
(setq space-vertices (get-polyline-vertices space-ent))
(setq space-detail-ss (ssget "_CP" space-vertices '((0 . "INSERT") (2 . "SpaceDetail"))))
(if (and space-detail-ss (= 1 (sslength space-detail-set)))
(progn
(setq space-detail-obj (vlax-ename->vla-object (ssname space-detail-set 0)))
(setq space-usage (strcase (get-attribute-value space-detail-obj "SPACEUSAGE")))
(princ (strcat "\n - Found Space with usage: '" space-usage "'. Area: " (rtos space-area)))
(if (and (wcmatch space-usage "*BATH*,*WC*,*W.C*,*TOILET*") (not (wcmatch space-usage "*MAID*")))
(setq bath-count (1+ bath-count))
)
(if (and (wcmatch space-usage "*BED*") (not (wcmatch space-usage "*MAID*")))
(setq bed-count (1+ bed-count))
)
(if (member space-usage '("SHAFT" "VOID"))
(setq void-shaft-area (+ void-shaft-area space-area))
)
(if (member space-usage '("SHAFT" "VOID" "LIFT" "STAIR" "STAIRS"))
(setq all-deductions-area (+ all-deductions-area space-area))
)
)
(princ (strcat "\n - Warning: Found a space polyline without a single valid 'SpaceDetail' block inside. Skipping area calculation for this space."))
)
(setq j (1+ j))
)
)
)
(princ (strcat "\n Select classification for Unit " unit-num-val ":"))
(princ "\n 1: Duplex")
(princ "\n 2: Triplex")
(princ "\n 3: Apartment")
(princ "\n 4: Unit")
(princ "\n 5: Retail shop")
(princ "\n 6: Office")
(initget "1 2 3 4 5 6")
(setq user-choice (getkword "\nEnter choice [1-6]: "))
(setq unit-classification
(cond
((= user-choice "1") "Duplex")
((= user-choice "2") "Triplex")
((= user-choice "3") "Apartment")
((= user-choice "4") "Unit")
((= user-choice "5") "Retail shop")
((= user-choice "6") "Office")
)
)
(setq total-deduction-area void-shaft-area)
(if (member unit-classification '("Duplex" "Triplex"))
(progn
(initget "Upper Lower")
(setq duplex-level (getkword (strcat "\n Is Unit " unit-num-val " Upper or Lower? [Upper/Lower]: ")))
(if (= duplex-level "Upper")
(setq total-deduction-area all-deductions-area)
)
)
)
(setq net-area (- unit-area total-deduction-area))
(princ (strcat "\n - Total Deduction: " (rtos total-deduction-area)))
(princ (strcat "\n - Calculated Net Area: " (rtos net-area)))
(princ (strcat "\n - Bathroom Count: " (itoa bath-count)))
(princ (strcat "\n - Bedroom Count: " (itoa bed-count)))
(set-attribute-value unit-detail-obj "UNITAREA" (rtos net-area 2 2))
(set-attribute-value unit-detail-obj "UNITCLASSIFICATION" unit-classification)
(set-attribute-value unit-detail-obj "UNITNUMBATHROOM" (itoa bath-count))
(set-attribute-value unit-detail-obj "UNITNUMBEDROOM" (itoa bed-count))
(princ (strcat "\n - Updated attributes in UnitDetail block."))
)
(princ (strcat "\n - Warning: Found zero or multiple 'UnitDetail' blocks inside unit. Skipping this unit."))
)
(setq i (1+ i))
)
)
(princ "\nNo unit boundaries found on layer 'Unit'.")
)
(princ "\n--- NET AREA CALCULATION COMPLETE ---")
)
;;;-------------------------------------------------------------------
;;; ENHANCED MASTER COMMAND WITH USER PROMPTS
;;;-------------------------------------------------------------------
(defun c:RUN-ALL-ENHANCED ( / *error* adoc detail-ss k block-obj original-scales restore-flag restore-choice insertion-point scale-factor user-choice door-relationships)
(defun *error* (msg)
(if (and original-scales restore-flag)
(progn
(princ "\nError occurred. Restoring original block scales.")
(foreach block-data original-scales
(setq block-obj (car block-data))
(if (not (vlax-object-released-p block-obj))
(progn
(setq insertion-point (vlax-safearray->list (vlax-variant-value (cadr block-data))))
(setq scale-factor (/ (caddr block-data) (vla-get-xscalefactor block-obj)))
(vla-scaleentity block-obj (vlax-3d-point insertion-point) scale-factor)
)
)
)
(princ " Done.")
)
)
(if adoc (vla-endundomark adoc))
(if (not (wcmatch (strcase msg) "*QUIT*,*CANCEL*")) (princ (strcat "\nError: " msg)))
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
;; Scale down detail blocks for processing
(setq original-scales nil restore-flag nil)
(setq detail-ss (ssget "_X" '((0 . "INSERT") (8 . "DoorDetail,WindowDetail,SpaceDetail"))))
(if detail-ss
(progn
(setq restore-flag T)
(princ "\nScaling down detail blocks...")
(setq k 0)
(repeat (sslength detail-ss)
(setq block-obj (vlax-ename->vla-object (ssname detail-ss k)))
(setq insertion-point (vla-get-insertionpoint block-obj))
(setq original-scales (cons (list block-obj insertion-point (vla-get-xscalefactor block-obj)) original-scales))
(vla-scaleentity block-obj (vlax-3d-point (vlax-safearray->list (vlax-variant-value insertion-point))) 0.001)
(setq k (1+ k))
)
(princ (strcat " Done. " (itoa (length original-scales)) " blocks scaled."))
)
)
;; Main menu with user choices
(princ "\n\n=== ENHANCED MASTER COMMAND ===")
(princ "\nAvailable operations:")
(princ "\n1. Full Update Process (Unit/Floor/Building boundaries)")
(princ "\n2. Detail Synchronization (Doors/Windows with Spaces)")
(princ "\n3. Net Area Calculation")
(princ "\n4. Door-Space Relationship Analysis")
(princ "\n5. Run All Operations")
(setq continue-processing T)
(while continue-processing
(princ "\n\nSelect operation [1/2/3/4/5/Quit]: ")
(initget "1 2 3 4 5 Quit")
(setq user-choice (getkword))
(cond
((= user-choice "1")
(princ "\n\nStarting Full Update Process...")
(run-full-update-logic)
)
((= user-choice "2")
(princ "\n\nStarting Detail Synchronization...")
(run-sync-logic)
)
((= user-choice "3")
(princ "\n\nStarting Net Area Calculation...")
(run-calc-net-area-logic)
)
((= user-choice "4")
(princ "\n\nStarting Door-Space Relationship Analysis...")
(setq door-relationships (analyze-door-space-relationships))
(modify-door-materials door-relationships)
)
((= user-choice "5")
(princ "\n\nRunning All Operations...")
(run-full-update-logic)
(run-sync-logic)
(run-calc-net-area-logic)
(setq door-relationships (analyze-door-space-relationships))
(modify-door-materials door-relationships)
(setq continue-processing nil)
)
((= user-choice "Quit")
(setq continue-processing nil)
)
(t
(princ "\nInvalid choice. Please try again.")
)
)
(if continue-processing
(progn
(princ "\n\nContinue with another operation? [Yes/No]: ")
(initget "Yes No")
(setq user-choice (getkword))
(if (= user-choice "No")
(setq continue-processing nil)
)
)
)
)
;; Restore block scales
(if (and original-scales restore-flag)
(progn
(initget "Yes No")
(setq restore-choice (getkword "\nDo you want to restore original block scales? [Yes/No]: "))
(if (or (not restore-choice) (= restore-choice "Yes"))
(progn
(princ "\nRestoring original block scales...")
(foreach block-data original-scales
(setq block-obj (car block-data))
(setq insertion-point (vlax-safearray->list (vlax-variant-value (cadr block-data))))
(setq scale-factor (/ (caddr block-data) (vla-get-xscalefactor block-obj)))
(if (not (vlax-object-released-p block-obj))
(vla-scaleentity block-obj (vlax-3d-point insertion-point) scale-factor)
)
)
(princ " Done.")
)
)
)
)
(vla-endundomark adoc)
(princ "\n\n--- ENHANCED MASTER COMMAND COMPLETE ---")
(princ)
)
(princ "\nLoaded enhanced master command: RUN-ALL-ENHANCED")
(princ "\nNew features:")
(princ "\n- Interactive menu system")
(princ "\n- Door-space relationship analysis")
(princ "\n- Door material modification")
(princ "\n- Individual operation selection")
(princ)
AutoDPL B - v01.lsp
This LISP routine automatically creates linear dimensions around selected polylines in AutoCAD. It calculates the bounding box of the selected polylines and then generates dimensions on all four sides (bottom, right, top, left). Users can specify an offset distance for these dimensions, or the routine will use a default based on DIMSCALE and DIMTXT system variables. This is useful for quickly dimensioning the overall extent of a drawing element.
(defun c:AutoDPL (/ ss i ent entlist pts allpts minX maxX minY maxY dimGap userGap input)
(vl-load-com)
;; Ask user for offset
(initget 6) ; restrict to positive numbers only
(setq userGap (getdist "\nEnter offset distance for dimensions : "))
;; Use user input or default
(setq dimGap
(if userGap
userGap
(* 3.0 (getvar "DIMSCALE") (getvar "DIMTXT"))
)
)
;; Select all LWPOLYLINEs
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(if ss
(progn
(setq i 0 allpts '())
(while (< i (sslength ss))
(setq ent (ssname ss i)
entlist (entget ent)
)
(foreach pair entlist
(if (= (car pair) 10)
(setq allpts (cons (cdr pair) allpts))
)
)
(setq i (1+ i))
)
;; Find bounding box
(setq minX (apply 'min (mapcar 'car allpts)))
(setq maxX (apply 'max (mapcar 'car allpts)))
(setq minY (apply 'min (mapcar 'cadr allpts)))
(setq maxY (apply 'max (mapcar 'cadr allpts)))
;; Start UNDO group
(command "UNDO" "BEGIN")
;; Draw dimensions: bottom, right, top, left
(command "DIMLINEAR" (list minX minY) (list maxX minY) (list (/ (+ minX maxX) 2) (- minY dimGap)) "")
(command "DIMLINEAR" (list maxX minY) (list maxX maxY) (list (+ maxX dimGap) (/ (+ minY maxY) 2)) "")
(command "DIMLINEAR" (list maxX maxY) (list minX maxY) (list (/ (+ minX maxX) 2) (+ maxY dimGap)) "")
(command "DIMLINEAR" (list minX maxY) (list minX minY) (list (- minX dimGap) (/ (+ minY maxY) 2)) "")
(command "UNDO" "END")
)
(prompt "\nNothing selected.")
)
(princ)
)
COPYINSIDE-ALLTYPES_Version3.lsp
This LISP routine facilitates copying AutoCAD objects based on a user-defined closed polyline boundary. Users can either draw a new boundary or select an existing one. The script then identifies and copies all objects that are either entirely contained within the boundary or are crossing it, using a specified base point and displacement. This is highly useful for isolating and duplicating specific parts of a drawing.
(defun c:COPYINSIDE (/ *error* ss base_pt disp_pt old_echo pline_ent pt_list keep_poly
;;; --- New variables for offset functionality ---
offset_dist selection_boundary temporary_boundary offset_pline)
;; --- Error handler to restore settings ---
(defun *error* (msg)
(setvar "CMDECHO" old_echo)
(if (and temporary_boundary (entget selection_boundary)) ; Ensure temp boundary is deleted on error
(entdel selection_boundary)
)
(princ)
)
;; --- Setup ---
(setq old_echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;;; --- Updated version information ---
(princ "\n--- Copy Inside Polygon (v4.0 - Offset & Keep Polygon) ---")
(princ "\nDraw your polygon using polyline. Use A for arcs, L for lines.")
;; --- Let user draw a polyline ---
(command "_.PLINE")
(while (= (logand (getvar "CMDACTIVE") 1) 1)
(command pause)
)
;; Get the last drawn polyline
(setq pline_ent (entlast))
;; Validate the polyline
(if (and pline_ent
(= (cdr (assoc 0 (entget pline_ent))) "LWPOLYLINE")
(>= (cdr (assoc 90 (entget pline_ent))) 3))
(progn
;;; --- START: Added Offset Functionality ---
;; --- Get offset distance ---
(setq offset_dist (getdist "\nEnter offset distance for selection boundary <0.0>: "))
(if (not offset_dist) (setq offset_dist 0.0)) ; Default to 0 if user presses Enter
;; --- Determine the selection boundary (original or offset) ---
(setq selection_boundary pline_ent) ; Default to the polyline that was just drawn
(setq temporary_boundary nil) ; A flag to tell us if we created a temporary entity
;; If the user entered a valid offset distance, perform the offset
(if (> offset_dist 1e-6) ; Check for a small but positive distance
(progn
(command "_.OFFSET" offset_dist pline_ent)
(princ "\nSpecify a point on the side to offset for selection.")
(command PAUSE) ; Let the user click the side
(command "") ; Exit the offset command cleanly
(setq offset_pline (entlast)) ; The newly created offset polyline
;; Check if the offset was successful and created a new entity
(if (and offset_pline (not (equal offset_pline pline_ent)))
(progn
(setq selection_boundary offset_pline) ; The new selection boundary is the offset polyline
(setq temporary_boundary T) ; Mark that we created a temporary entity to be deleted later
)
(princ "\nOffset failed. Using original boundary.")
)
)
)
;; --- Get the selection boundary's vertex list ---
(setq pt_list nil)
(foreach pair (entget selection_boundary)
(if (= (car pair) 10)
(setq pt_list (append pt_list (list (cdr pair))))
)
)
;; --- Delete the temporary offset polyline if it was created ---
(if temporary_boundary
(entdel selection_boundary)
)
;;; --- END: Added Offset Functionality ---
;; --- Select objects completely inside the final boundary ---
(setq ss (ssget "_WP" pt_list))
;; Ask if user wants to keep the *originally drawn* polygon
(initget "Yes No")
(setq keep_poly (getkword "\nKeep the originally drawn polygon? [Yes/No] : "))
(if (or (not keep_poly) (= keep_poly "No"))
(entdel pline_ent)
)
;; --- Proceed if selection found ---
(if ss
(progn
(princ (strcat "\n" (itoa (sslength ss)) " objects selected."))
;; Get base and displacement points
(setq base_pt (getpoint "\nSpecify base point for copy: "))
(if base_pt
(progn
(setq disp_pt (getpoint base_pt "\nSpecify second point (displacement): "))
(if disp_pt
(command "_.COPY" ss "" "_non" base_pt "_non" disp_pt)
)
)
)
)
(princ "\nNo objects were found completely inside the selection boundary.")
)
)
(princ "\nInvalid polyline. Must contain at least 3 vertices.")
)
;; Cleanup
(*error* nil)
)
;;; --- Updated load message ---
(princ "\nLISP routine 'COPYINSIDE' (v4.0 - Offset & Keep Polygon) loaded. Type COPYINSIDE to run.")
(princ)
DECURVE.lsp
This LISP routine (command `Jm`) simplifies the process of combining multiple AutoCAD entities into a single polyline. Users select LWPOLYLINES, CIRCLES, and ARCS, and the script then uses the PEDIT command to join them, creating a continuous polyline. This is useful for consolidating drawing elements into a unified object.
(defun c:Jm ()
(vl-load-com) ; Load Visual LISP extensions
(setq ss (ssget '((0 . "LWPOLYLINE,CIRCLE,ARC")))) ; Select polylines, arcs, and circles
(if ss
(progn
(command "_.PEDIT" "_M" ss "_J" "_Y" "") ; Join selected objects
(princ "\nSuccessfully joined the selected objects into a single polyline.")
)
(princ "\nNo valid objects selected.")
)
(princ)
)
dups.lsp
This LISP routine (command `vs`) helps identify and visualize duplicate vertices in LWPOLYLINES within an AutoCAD drawing. It processes selected polylines, detects vertices that are coincident or very close to each other (within a defined fuzz distance), and then interactively zooms to each duplicate location, marking it with a temporary circle. This is a valuable tool for cleaning up polyline geometry and ensuring data integrity.
(defun vs ( / e i s )
(if (setq s (ssget "_x" '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength s)))
(foreach x
(LM:ListDupesFuzz
(vl-remove-if-not ' (lambda ( x ) (= 10 (car x)))
(setq e (entget (ssname s (setq i (1- i)))))
)
1e-8
)
(command "_.zoom" "_Object"
(entmakex
(list
'(0 . "CIRCLE")
'(8 . "Duplicate-Vertices") ;; Layer
x
'(40 . 1.0) ;; Radius
'(62 . 1) ;; Colour
(assoc 210 e)
)
)
""
)
(princ "\nPress any key to view next duplicate...")
(grread)
)
)
)
(princ)
)
;; List Duplicates with Fuzz - Lee Mac
;; Returns a list of items appearing more than once in a supplied list
(defun LM:ListDupesFuzz ( l f / c r x )
(while l
(setq x (car l)
c (length l)
l (vl-remove-if ' (lambda ( y ) (equal x y f)) (cdr l))
)
(if (< (length l) (1- c))
(setq r (cons x r))
)
)
(reverse r)
)
(princ)
explodeAll2 .lsp
This LISP routine (command `expl`) provides a quick way to manage the explodability of all blocks in an AutoCAD drawing. Users can choose to set all blocks as either explodable or non-explodable, excluding XREFs and layout blocks. This is particularly useful for controlling how blocks behave when the EXPLODE command is used, enhancing drawing integrity or facilitating mass editing.
(defun c:expl (/ f)
;; RJP © 2020-02-12
(initget "E N")
(setq (cond ((= "E" (getkword "\nBlocks [Explodable/NON_Explodable]: ")) -1)
(0)
)
)
(vlax-for b (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(and (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-put b 'explodable f))
)
(princ)
)
(vl-load-com)
lineWeightZoomExtents.lsp
This LISP routine (command `LWZE`) provides a quick utility to enhance drawing visibility. It automatically turns on the display of lineweights in AutoCAD and then performs a
Using Python to automate geospatial workflows in ArcGIS.Python for GIS
import arcpy
def analyze_data(input_fc):
desc = arcpy.Describe(input_fc)
print(f"Analyzing {desc.name}...")
Video Demonstration