;;; =========================================================================== ;;; Routine Name: EXTCOORD (Extract Coordinates - DCL UI Version) ;;; Version: 2026.24 (Spot Elevation fix v4) (Ultimate Dynamic Engine + C3D Geometric Filter) ;;; Description: Fully dynamic AutoCAD tables linked directly to source points. ;;; Features unbreakable Geometric Filter for C3D Markers. ;;; =========================================================================== (vl-load-com) ;; ============================ ;; PERSISTENT SETTINGS HELPERS ;; ============================ (defun EXT:get-setting (key default / value) (setq value (getenv key)) (if value value default) ) (defun EXT:set-setting (key value) (if value (setenv key value)) ) (defun EXT:positive-int (value default / number) (setq number (atoi value)) (if (> number 0) number default) ) ;; Build a native selection filter so AutoCAD highlights only the entity types. (defun EXT:selection-filter (allowedTypes / filter type has2d has3d) (setq filter (list '(-4 . "") '(-4 . "AND>"))))) (has3d (setq filter (append filter (list '(-4 . ""))))) ) (if (member "SPOTELEV" allowedTypes) (setq filter (append filter (list '(0 . "AECC*ELEVATION*,AECC*SPOT*"))))) (append filter (list '(-4 . "OR>"))) ) ;; Match legacy POLYLINE entities by their 2D/3D flag during processing (defun EXT:entity-allowed-p (ent allowedTypes / data type flags) (setq data (entget ent) type (cdr (assoc 0 data))) (cond ((EXT:spot-type-p type) (member "SPOTELEV" allowedTypes)) ((= type "POLYLINE") (progn (setq flags (cond ((cdr (assoc 70 data))) (0))) (if (/= 0 (logand flags 8)) (member "3DPOLYLINE" allowedTypes) (member "POLYLINE" allowedTypes) ) ) ) (T (member type allowedTypes)) ) ) ;; 64-Bit Safe Object ID Extractor for Fields (defun get-obj-id-str (vla-obj / util) (setq util (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (vlax-method-applicable-p util 'GetObjectIdString) (vlax-invoke-method util 'GetObjectIdString vla-obj :vlax-false) (itoa (vla-get-ObjectID vla-obj)) ) ) ;; ============================ ;; SPOT ELEVATION HELPERS (FIX) ;; ============================ ;; Civil 3D spot elevation labels have different DXF names between versions ;; (AECC_SURFACE_ELEVATION_LABEL, AECC_SPOT_ELEVATION_LABEL, ...). Match by wildcard. (defun EXT:spot-type-p (type) (and type (wcmatch (strcase type) "AECC*ELEVATION*,AECC*SPOT*")) ) ;; Keep all points of each closed element successive in the numbering. ;; Walks the sorted list; when a point belongs to a closed element, all of ;; that element's points are emitted together (in vertex order) before ;; continuing to the next element. (defun EXT:regroup-closed (gathered closedEnts / out done item e it2) (setq out '() done '()) (foreach item gathered (setq e (nth 0 item)) (if (member e closedEnts) (if (not (member e done)) (progn (foreach it2 gathered (if (equal (nth 0 it2) e) (setq out (cons it2 out))) ) (setq done (cons e done)) ) ) (setq out (cons item out)) ) ) (reverse out) ) ;; Pull the first decimal number from a label string (e.g. "EL 123.456" -> 123.456) (defun EXT:first-number (str / i ch tok best) (setq i 1 tok "" best nil) (if (and str (not (numberp str)) (not (listp str))) (while (and (not best) (<= i (1+ (strlen str)))) (setq ch (if (<= i (strlen str)) (substr str i 1) " ")) (if (or (wcmatch ch "#") (= ch ".") (and (= ch "-") (= tok ""))) (setq tok (strcat tok ch)) (progn (if (and (vl-string-search "." tok) (distof tok 2)) (setq best (distof tok 2))) (setq tok ""))) (setq i (1+ i)))) best ) ;; Explode a COPY of the label with the EXPLODE command, read marker centre + elevation ;; text, then erase the debris. Returns (x y z) or nil. ;; Pick the exact marker point: smallest circle centre if any, otherwise the ;; point where the most line ends/midpoints coincide (crosshair centre). ;; Never averages, so the leader line and arrow cannot shift the result. (defun EXT:pick-marker (circs geom / ext tol best bestScore sc p q) (cond (circs (setq circs (vl-sort circs '(lambda (a b) (< (car a) (car b))))) (cadr (car circs))) (geom (setq ext (max (- (apply 'max (mapcar 'car geom)) (apply 'min (mapcar 'car geom))) (- (apply 'max (mapcar 'cadr geom)) (apply 'min (mapcar 'cadr geom)))) tol (max 1e-6 (* ext 0.01)) bestScore -1) (foreach p geom (setq sc 0) (foreach q geom (if (< (distance (list (car p) (cadr p)) (list (car q) (cadr q))) tol) (setq sc (1+ sc)))) (if (> sc bestScore) (setq bestScore sc best p))) best) ) ) (defun EXT:spot-from-explode (obj / cpy last e new geom circs best zval data ty pass more mn mx l1 l2 oldEcho) (setq cpy (vl-catch-all-apply 'vla-Copy (list obj))) (if (and cpy (not (vl-catch-all-error-p cpy))) (progn (setq oldEcho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq last (entlast)) (setq e (vl-catch-all-apply 'vlax-vla-object->ename (list cpy))) (if (and e (not (vl-catch-all-error-p e))) (vl-cmdf "_.EXPLODE" e "")) (setq new '() e (if last (entnext last) (entnext))) (while e (setq new (cons e new) e (entnext e))) ;; explode nested blocks a few levels deep (setq pass 0) (while (and (< pass 3) (vl-some '(lambda (x) (= (cdr (assoc 0 (entget x))) "INSERT")) new)) (foreach x new (if (and (entget x) (= (cdr (assoc 0 (entget x))) "INSERT")) (progn (setq last (entlast)) (vl-cmdf "_.EXPLODE" x "") (setq e (if last (entnext last) nil)) (while e (setq new (cons e new) e (entnext e)))))) (setq new (vl-remove-if-not '(lambda (x) (and x (entget x))) new) pass (1+ pass))) (setvar "CMDECHO" oldEcho) (setq geom '()) (foreach x new (setq data (if x (entget x)) ty (cdr (assoc 0 data))) (cond ((member ty '("TEXT" "MTEXT" "ATTRIB" "ATTDEF")) (if (not zval) (setq zval (EXT:first-number (cdr (assoc 1 data)))))) ;; circles = marker symbol (weight 3, keep radius so smallest wins ties) ((member ty '("CIRCLE" "ARC")) (setq circs (cons (list (cdr (assoc 40 data)) (cdr (assoc 10 data))) circs))) ;; lines: endpoints + midpoint (crosshair lines share a midpoint at the marker) ((= ty "LINE") (setq l1 (cdr (assoc 10 data)) l2 (cdr (assoc 11 data))) (setq geom (append (list l1 l2 (mapcar '(lambda (u v) (/ (+ u v) 2.0)) l1 l2)) geom))) ((= ty "LWPOLYLINE") (foreach g data (if (= (car g) 10) (setq geom (cons (cdr g) geom))))) ) ) (foreach x new (if (and x (entget x)) (entdel x))) ;; copy may already be gone after EXPLODE - delete safely (vl-catch-all-apply 'vla-Delete (list cpy)) (setq best (EXT:pick-marker circs geom)) (if best (list (car best) (cadr best) (if zval zval 0.0))) ) ) ) ;; ============================ ;; SORTING ALONG PATH HELPER ;; ============================ (defun get-dist-on-curve (pathObj pt / projPt dist) (setq projPt (vl-catch-all-apply 'vlax-curve-getClosestPointTo (list pathObj pt))) (if (vl-catch-all-error-p projPt) 1e99 (progn (setq dist (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list pathObj projPt))) (if (vl-catch-all-error-p dist) 1e99 dist) ) ) ) ;; ============================ ;; DIALOG UI GENERATOR ;; ============================ (defun show-extcoord-dialog ( / dcl-id dcl-file f res allowedList outTypes insPt insNum makeTable startNum incr maxRows sortMethod pt-val ln-val pl-val 3d-val cir-val arc-val blk-val spl-val fl-val spot-val sort-val csv-val txt-val gsi-val inspt-val insnum-val tbl-val st-val inc-val row-val) (setq dcl-file (vl-filename-mktemp "extcoord.dcl")) (setq f (open dcl-file "w")) (write-line "extcoord_dlg : dialog { label = \"EXTCOORD - Export Settings\";" f) (write-line " : row {" f) (write-line " : boxed_column { label = \"Entity Types to Extract\";" f) (write-line " : toggle { key = \"t_pt\"; label = \"Points / Cogo Points\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_ln\"; label = \"Lines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_pl\"; label = \"Polylines (2D)\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_3d\"; label = \"3D Polylines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_cir\"; label = \"Circles\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_arc\"; label = \"Arcs\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_blk\"; label = \"Blocks (Inserts)\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_spl\"; label = \"Splines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_fl\"; label = \"Feature Lines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_spot\"; label = \"Surface Spot Elevations\"; value = \"1\"; }" f) (write-line " : row {" f) (write-line " : button { key = \"btn_all_ents\"; label = \"Select All\"; }" f) (write-line " : button { key = \"btn_no_ents\"; label = \"Deselect All\"; }" f) (write-line " }" f) (write-line " }" f) (write-line " : column {" f) (write-line " : boxed_column { label = \"Numbering Settings\";" f) (write-line " : popup_list { key = \"l_sort\"; label = \"Sort Numbering By:\"; width = 30; }" f) (write-line " : edit_box { key = \"e_start\"; label = \"Start Number:\"; edit_width = 8; }" f) (write-line " : edit_box { key = \"e_incr\"; label = \"Increment:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Drawing Options\";" f) (write-line " : toggle { key = \"t_inspt\"; label = \"Insert Point Markers (Must tick for C3D Tables)\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_insnum\"; label = \"Show Text Numbering (Links ID)\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_tbl\"; label = \"Create AutoCAD Table (Dynamic Fields)\"; value = \"0\"; }" f) (write-line " : edit_box { key = \"e_maxrow\"; label = \"Max Rows / Table:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Export Formats (Uncheck all for None)\";" f) (write-line " : toggle { key = \"t_csv\"; label = \"Export to CSV\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_txt\"; label = \"Export to TXT\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_gsi\"; label = \"Export to GSI\"; value = \"1\"; }" f) (write-line " }" f) (write-line " }" f) (write-line " }" f) (write-line " ok_cancel;" f) (write-line "}" f) (close f) (setq dcl-id (load_dialog dcl-file)) (if (not (new_dialog "extcoord_dlg" dcl-id)) (progn (alert "Dialog failed to load.") (exit)) ) ;; Populate Dropdown (start_list "l_sort") (mapcar 'add_list '("1. Default (Selection Order)" "2. Left to Right (X Axis)" "3. Top to Bottom (Y Axis)" "4. Along a Path (Select/Draw Polyline)")) (end_list) (setq *extcoord-last-num* (EXT:positive-int (EXT:get-setting "EXTCOORD_START" "1") 1)) (setq *extcoord-last-incr* (EXT:positive-int (EXT:get-setting "EXTCOORD_INCREMENT" "1") 1)) (setq *extcoord-last-row* (EXT:positive-int (EXT:get-setting "EXTCOORD_MAXROWS" "50") 50)) (set_tile "t_pt" (EXT:get-setting "EXTCOORD_T_PT" "1")) (set_tile "t_ln" (EXT:get-setting "EXTCOORD_T_LN" "1")) (set_tile "t_pl" (EXT:get-setting "EXTCOORD_T_PL" "1")) (set_tile "t_3d" (EXT:get-setting "EXTCOORD_T_3D" "1")) (set_tile "t_cir" (EXT:get-setting "EXTCOORD_T_CIR" "1")) (set_tile "t_arc" (EXT:get-setting "EXTCOORD_T_ARC" "1")) (set_tile "t_blk" (EXT:get-setting "EXTCOORD_T_BLK" "1")) (set_tile "t_spl" (EXT:get-setting "EXTCOORD_T_SPL" "1")) (set_tile "t_fl" (EXT:get-setting "EXTCOORD_T_FL" "1")) (set_tile "t_spot" (EXT:get-setting "EXTCOORD_T_SPOT" "1")) (set_tile "t_csv" (EXT:get-setting "EXTCOORD_T_CSV" "1")) (set_tile "t_txt" (EXT:get-setting "EXTCOORD_T_TXT" "1")) (set_tile "t_gsi" (EXT:get-setting "EXTCOORD_T_GSI" "1")) (set_tile "t_inspt" (EXT:get-setting "EXTCOORD_T_INSPT" "1")) (set_tile "t_insnum" (EXT:get-setting "EXTCOORD_T_INSNUM" "1")) (set_tile "t_tbl" (EXT:get-setting "EXTCOORD_T_TBL" "0")) (set_tile "l_sort" (EXT:get-setting "EXTCOORD_SORT_METHOD" "0")) (set_tile "e_start" (itoa *extcoord-last-num*)) (set_tile "e_incr" (itoa *extcoord-last-incr*)) (set_tile "e_maxrow" (itoa *extcoord-last-row*)) (action_tile "btn_all_ents" "(foreach k '(\"t_pt\" \"t_ln\" \"t_pl\" \"t_3d\" \"t_cir\" \"t_arc\" \"t_blk\" \"t_spl\" \"t_fl\" \"t_spot\") (set_tile k \"1\"))") (action_tile "btn_no_ents" "(foreach k '(\"t_pt\" \"t_ln\" \"t_pl\" \"t_3d\" \"t_cir\" \"t_arc\" \"t_blk\" \"t_spl\" \"t_fl\" \"t_spot\") (set_tile k \"0\"))") (action_tile "accept" "(setq pt-val (get_tile \"t_pt\") ln-val (get_tile \"t_ln\") pl-val (get_tile \"t_pl\") 3d-val (get_tile \"t_3d\") cir-val (get_tile \"t_cir\") arc-val (get_tile \"t_arc\") blk-val (get_tile \"t_blk\") spl-val (get_tile \"t_spl\") fl-val (get_tile \"t_fl\") spot-val (get_tile \"t_spot\") csv-val (get_tile \"t_csv\") txt-val (get_tile \"t_txt\") gsi-val (get_tile \"t_gsi\") inspt-val (get_tile \"t_inspt\") insnum-val (get_tile \"t_insnum\") tbl-val (get_tile \"t_tbl\") sort-val (get_tile \"l_sort\") st-val (get_tile \"e_start\") inc-val (get_tile \"e_incr\") row-val (get_tile \"e_maxrow\")) (done_dialog 1)" ) (action_tile "cancel" "(done_dialog 0)") (setq res (start_dialog)) (unload_dialog dcl-id) (vl-file-delete dcl-file) (if (= res 1) (progn (setq allowedList (append (if (= pt-val "1") '("POINT" "AECC_COGO_POINT") '()) (if (= ln-val "1") '("LINE") '()) (if (= pl-val "1") '("LWPOLYLINE" "POLYLINE") '()) (if (= 3d-val "1") '("3DPOLYLINE") '()) (if (= cir-val "1") '("CIRCLE") '()) (if (= arc-val "1") '("ARC") '()) (if (= blk-val "1") '("INSERT") '()) (if (= spl-val "1") '("SPLINE") '()) (if (= fl-val "1") '("AECC_FEATURE_LINE") '()) (if (= spot-val "1") '("SPOTELEV") '()) )) (setq outTypes (append (if (= csv-val "1") '("CSV") '()) (if (= txt-val "1") '("TXT") '()) (if (= gsi-val "1") '("GSI") '()) )) (setq insPt (if (= inspt-val "1") "Yes" "No")) (setq insNum (if (= insnum-val "1") "Yes" "No")) (setq makeTable (if (= tbl-val "1") "Yes" "No")) (setq startNum (if (> (atoi st-val) 0) (atoi st-val) *extcoord-last-num*)) (setq incr (if (> (atoi inc-val) 0) (atoi inc-val) *extcoord-last-incr*)) (setq maxRows (if (> (atoi row-val) 0) (atoi row-val) *extcoord-last-row*)) (setq sortMethod sort-val) (setq *extcoord-last-num* startNum) (setq *extcoord-last-incr* incr) (setq *extcoord-last-row* maxRows) (EXT:set-setting "EXTCOORD_T_PT" pt-val) (EXT:set-setting "EXTCOORD_T_LN" ln-val) (EXT:set-setting "EXTCOORD_T_PL" pl-val) (EXT:set-setting "EXTCOORD_T_3D" 3d-val) (EXT:set-setting "EXTCOORD_T_CIR" cir-val) (EXT:set-setting "EXTCOORD_T_ARC" arc-val) (EXT:set-setting "EXTCOORD_T_BLK" blk-val) (EXT:set-setting "EXTCOORD_T_SPL" spl-val) (EXT:set-setting "EXTCOORD_T_FL" fl-val) (EXT:set-setting "EXTCOORD_T_SPOT" spot-val) (EXT:set-setting "EXTCOORD_T_CSV" csv-val) (EXT:set-setting "EXTCOORD_T_TXT" txt-val) (EXT:set-setting "EXTCOORD_T_GSI" gsi-val) (EXT:set-setting "EXTCOORD_T_INSPT" inspt-val) (EXT:set-setting "EXTCOORD_T_INSNUM" insnum-val) (EXT:set-setting "EXTCOORD_T_TBL" tbl-val) (EXT:set-setting "EXTCOORD_SORT_METHOD" sort-val) (EXT:set-setting "EXTCOORD_START" (itoa startNum)) (EXT:set-setting "EXTCOORD_INCREMENT" (itoa incr)) (EXT:set-setting "EXTCOORD_MAXROWS" (itoa maxRows)) (list allowedList outTypes insPt insNum makeTable startNum incr maxRows sortMethod) ) nil ) ) ;; ============================ ;; GSI-16 STRICT FORMATTING ;; ============================ (defun pad16 (n / s) (setq s (vl-string-left-trim " " (rtos (abs n) 2 0))) (while (< (strlen s) 16) (setq s (strcat "0" s)) ) (if (> (strlen s) 16) (setq s (substr s (- (strlen s) 15))) ) s ) (defun gsi-format (pt idx / xraw yraw zraw) (setq xraw (fix (+ (* (car pt) 1000.0) 0.5)) yraw (fix (+ (* (cadr pt) 1000.0) 0.5)) zraw (fix (+ (* (caddr pt) 1000.0) 0.5))) (strcat "*11....+" (pad16 idx) " " "81..40" (if (>= xraw 0) "+" "-") (pad16 xraw) " " "82..40" (if (>= yraw 0) "+" "-") (pad16 yraw) " " "83..40" (if (>= zraw 0) "+" "-") (pad16 zraw) " " "71....+0000000000000000" ) ) ;; ============================ ;; DRAWING HELPERS (With Object ID Returns) ;; ============================ (defun draw-number (num pt / currStyle currHeight ent) (setq currStyle (getvar "TEXTSTYLE")) (setq currHeight (cond ((> (getvar "TEXTSIZE") 0.0) (getvar "TEXTSIZE")) (T 2.5))) (setq ent (entmakex (list '(0 . "TEXT") (cons 1 (itoa num)) (cons 10 pt) (cons 40 currHeight) (cons 7 currStyle) '(50 . 0.0) '(72 . 0) '(73 . 0)))) (if ent (get-obj-id-str (vlax-ename->vla-object ent)) nil) ) (defun draw-marker-point (pt / ent) (setq ent (entmakex (list '(0 . "POINT") (cons 10 pt)))) (if ent (get-obj-id-str (vlax-ename->vla-object ent)) nil) ) (defun make-coord-tables (dataList maxRows textHt / acadObj doc space currPt rows thisBatch tableObj r idx x y z txtID ptID srcID srcType srcDetail) (setq acadObj (vlax-get-acad-object) doc (vla-get-ActiveDocument acadObj) space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace doc) (vla-get-ModelSpace doc))) (setq currPt (getpoint "\nSelect insertion point for table(s): ")) (if currPt (while dataList (setq thisBatch '() rows 0) (while (and dataList (< rows maxRows)) (setq thisBatch (cons (car dataList) thisBatch)) (setq dataList (cdr dataList)) (setq rows (1+ rows)) ) (setq thisBatch (reverse thisBatch)) (setq tableObj (vla-AddTable space (vlax-3d-point currPt) (+ rows 2) 4 (* textHt 2.0) (* textHt 15.0))) ;; --- SPEED FIX: Suppress graphic regeneration while writing --- (vl-catch-all-apply 'vla-put-RegenerateTableSuppressed (list tableObj :vlax-true)) (vl-catch-all-apply 'vla-SetTextHeight (list tableObj 7 textHt)) (vla-SetText tableObj 0 0 "COORDINATES") (vla-SetText tableObj 1 0 "POINT") (vla-SetText tableObj 1 1 "EASTING (X)") (vla-SetText tableObj 1 2 "NORTHING (Y)") (vla-SetText tableObj 1 3 "ELEVATION (Z)") (setq r 2) (foreach row thisBatch (setq idx (nth 0 row) x (nth 1 row) y (nth 2 row) z (nth 3 row) txtID (nth 4 row) ptID (nth 5 row) srcID (nth 6 row) srcType (nth 7 row) srcDetail (nth 8 row)) ;; Dynamic ID Column (if txtID (vla-SetText tableObj r 0 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).TextString>%")) (vla-SetText tableObj r 0 (itoa idx)) ) ;; Dynamic Easting (X) Column (cond (ptID (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " ptID ">%).Coordinates \\f \"%lu2%pr4%pt1\">%"))) (srcID (cond ((= srcType "AECC_COGO_POINT") (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Easting \\f \"%lu2%pr4\">%"))) ((= srcType "POINT") (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Coordinates \\f \"%lu2%pr4%pt1\">%"))) ((member srcType '("INSERT")) (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).InsertionPoint \\f \"%lu2%pr4%pt1\">%"))) ((member srcType '("CIRCLE" "ARC")) (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Center \\f \"%lu2%pr4%pt1\">%"))) ((= srcType "LINE") (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%)." srcDetail " \\f \"%lu2%pr4%pt1\">%"))) ((EXT:spot-type-p srcType) (vla-SetText tableObj r 1 (rtos x 2 4))) (T (if txtID (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt1\">%")) (vla-SetText tableObj r 1 (rtos x 2 4)))) ) ) (txtID (vla-SetText tableObj r 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt1\">%"))) (T (vla-SetText tableObj r 1 (rtos x 2 4))) ) ;; Dynamic Northing (Y) Column (cond (ptID (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " ptID ">%).Coordinates \\f \"%lu2%pr4%pt2\">%"))) (srcID (cond ((= srcType "AECC_COGO_POINT") (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Northing \\f \"%lu2%pr4\">%"))) ((= srcType "POINT") (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Coordinates \\f \"%lu2%pr4%pt2\">%"))) ((member srcType '("INSERT")) (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).InsertionPoint \\f \"%lu2%pr4%pt2\">%"))) ((member srcType '("CIRCLE" "ARC")) (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Center \\f \"%lu2%pr4%pt2\">%"))) ((= srcType "LINE") (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%)." srcDetail " \\f \"%lu2%pr4%pt2\">%"))) ((EXT:spot-type-p srcType) (vla-SetText tableObj r 2 (rtos y 2 4))) (T (if txtID (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt2\">%")) (vla-SetText tableObj r 2 (rtos y 2 4)))) ) ) (txtID (vla-SetText tableObj r 2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt2\">%"))) (T (vla-SetText tableObj r 2 (rtos y 2 4))) ) ;; Dynamic Elevation (Z) Column (cond (ptID (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " ptID ">%).Coordinates \\f \"%lu2%pr4%pt4\">%"))) (srcID (cond ((= srcType "AECC_COGO_POINT") (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Elevation \\f \"%lu2%pr4\">%"))) ((= srcType "POINT") (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Coordinates \\f \"%lu2%pr4%pt4\">%"))) ((member srcType '("INSERT")) (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).InsertionPoint \\f \"%lu2%pr4%pt4\">%"))) ((member srcType '("CIRCLE" "ARC")) (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%).Center \\f \"%lu2%pr4%pt4\">%"))) ((= srcType "LINE") (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " srcID ">%)." srcDetail " \\f \"%lu2%pr4%pt4\">%"))) ((EXT:spot-type-p srcType) (vla-SetText tableObj r 3 (rtos z 2 4))) (T (if txtID (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt4\">%")) (vla-SetText tableObj r 3 (rtos z 2 4)))) ) ) (txtID (vla-SetText tableObj r 3 (strcat "%<\\AcObjProp Object(%<\\_ObjId " txtID ">%).InsertionPoint \\f \"%lu2%pr4%pt4\">%"))) (T (vla-SetText tableObj r 3 (rtos z 2 4))) ) (setq r (1+ r)) ) ;; --- SPEED FIX: Resume graphic regeneration --- (vl-catch-all-apply 'vla-put-RegenerateTableSuppressed (list tableObj :vlax-false)) (setq currPt (list (+ (car currPt) (* textHt 70.0)) (cadr currPt) (caddr currPt))) ) (princ "\nTable generation cancelled.") ) ) ;; ============================ ;; PROCESS ENGINE ;; ============================ (defun process-entities (lst allowedTypes start-num incr outTypes baseName insPt insNum makeTable maxRows sortMethod / ent type verts idx count obj coords fhCSV fhTXT fhGSI p skippedTypes typeStr st pIdx endPrm ptVar isClosed endLimit tableData txtID ptID srcID srcType srcDetail gathered pathEnt selPath p10 expObjs exType geomPts minPt maxPt closedEnts) (setq count 0 skippedTypes '() tableData '() gathered '() closedEnts '()) ;; PHASE 1: Gather raw coordinates securely (foreach ent lst (setq type (cdr (assoc 0 (entget ent)))) (setq verts nil) (setq srcID (if (or (member type '("POINT" "AECC_COGO_POINT" "INSERT" "CIRCLE" "ARC" "LINE")) (EXT:spot-type-p type)) (get-obj-id-str (vlax-ename->vla-object ent)) nil)) (setq srcType type) (if (EXT:entity-allowed-p ent allowedTypes) (cond ((member type '("POINT" "AECC_COGO_POINT" "CIRCLE" "ARC" "INSERT")) (setq p10 (cdr (assoc 10 (entget ent)))) (if (and p10 (listp p10) (>= (length p10) 2)) (setq verts (list p10)) ) ) ;; SPOT ELEVATION EXHAUSTIVE COORDINATE HUNTER ((EXT:spot-type-p type) (setq obj (vlax-ename->vla-object ent)) (setq p10 nil) ;; TIER 1: Native COM Anchor Extraction (setq ptVar (vl-catch-all-apply 'vlax-get (list obj 'AnchorInfo))) (if (and ptVar (not (vl-catch-all-error-p ptVar))) (progn (setq ptVar (vl-catch-all-apply 'vlax-get (list ptVar 'Location))) (if (and ptVar (not (vl-catch-all-error-p ptVar)) (listp ptVar) (>= (length ptVar) 2)) (setq p10 ptVar) ) ) ) (if (not p10) (foreach prop '(AnchorPoint FeatureLocation) (if (not p10) (progn (setq ptVar (vl-catch-all-apply 'vlax-get (list obj prop))) (if (and ptVar (not (vl-catch-all-error-p ptVar)) (listp ptVar) (>= (length ptVar) 2)) (setq p10 ptVar) ) ) ) ) ) ;; TIER 2: VLAX Explode & Geometric Filter (The ultimate physical marker hunter) (if nil ;; tier 2 disabled - averaging shifted the point off the marker (progn (setq expObjs (vl-catch-all-apply 'vlax-invoke (list obj 'Explode))) (if (and expObjs (not (vl-catch-all-error-p expObjs)) (listp expObjs) (vl-every '(lambda (x) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-ObjectName (list x))))) expObjs)) (progn (setq geomPts '()) ;; Explicitly filter out ALL text to guarantee we only measure the marker (foreach ex expObjs (setq exType (vl-catch-all-apply 'vla-get-ObjectName (list ex))) (if (and (not (vl-catch-all-error-p exType)) (not (wcmatch exType "*Text,*MText"))) (progn (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list ex 'minPt 'maxPt)))) (setq geomPts (cons (list (/ (+ (car (vlax-safearray->list minPt)) (car (vlax-safearray->list maxPt))) 2.0) (/ (+ (cadr (vlax-safearray->list minPt)) (cadr (vlax-safearray->list maxPt))) 2.0) (if (>= (length (vlax-safearray->list minPt)) 3) (/ (+ (caddr (vlax-safearray->list minPt)) (caddr (vlax-safearray->list maxPt))) 2.0) 0.0)) geomPts)) ) ) ) ) ;; Delete all debris instantly (foreach ex expObjs (vl-catch-all-apply 'vla-Delete (list ex))) ;; Average the remaining non-text geometry to hit the exact marker center (if (> (length geomPts) 0) (setq p10 (list (/ (apply '+ (mapcar 'car geomPts)) (float (length geomPts))) (/ (apply '+ (mapcar 'cadr geomPts)) (float (length geomPts))) (/ (apply '+ (mapcar 'caddr geomPts)) (float (length geomPts))))) ) ) ) ) ) ;; TIER 3 (FIX): EXPLODE command on a copy - works when COM methods are blocked (if (not (and p10 (listp p10) (>= (length p10) 2) (numberp (car p10)))) (setq p10 (EXT:spot-from-explode obj))) (if (and p10 (listp p10) (>= (length p10) 2) (numberp (car p10))) (setq verts (list (if (caddr p10) p10 (list (car p10) (cadr p10) 0.0)))) ) ) ((= type "LINE") (setq verts (list (cdr (assoc 10 (entget ent))) (cdr (assoc 11 (entget ent)))))) ((member type '("LWPOLYLINE" "POLYLINE" "3DPOLYLINE")) (setq obj (vlax-ename->vla-object ent)) (if (not (vl-catch-all-error-p (setq endPrm (vl-catch-all-apply 'vlax-curve-getEndParam (list obj))))) (progn (setq isClosed (vl-catch-all-apply 'vlax-curve-isClosed (list obj))) (setq endLimit (fix (+ endPrm 0.001))) (if (and (not (vl-catch-all-error-p isClosed)) isClosed) (progn (setq endLimit (1- endLimit)) (setq closedEnts (cons ent closedEnts)) ) ) (setq pIdx 0) (while (<= pIdx endLimit) (if (not (vl-catch-all-error-p (setq ptVar (vl-catch-all-apply 'vlax-curve-getPointAtParam (list obj pIdx))))) (if ptVar (setq verts (cons ptVar verts))) ) (setq pIdx (1+ pIdx)) ) ) ) (setq verts (reverse verts))) ((member type '("SPLINE" "AECC_FEATURE_LINE")) (setq obj (vlax-ename->vla-object ent)) (if (vlax-method-applicable-p obj 'GetPoints) (setq coords (vlax-invoke obj 'GetPoints)) (setq coords nil)) (if coords (repeat (/ (length coords) 3) (setq verts (cons (list (car coords) (cadr coords) (caddr coords)) verts)) (setq coords (cdddr coords)))) (setq verts (reverse verts))) ) ) (if verts (progn (setq pIdx 0) (foreach p verts (if (and p (listp p) (>= (length p) 2) (numberp (car p)) (numberp (cadr p))) (progn (setq p (list (float (car p)) (float (cadr p)) (if (and (>= (length p) 3) (caddr p) (numberp (caddr p))) (float (caddr p)) 0.0))) (setq srcDetail "") (if (= type "LINE") (if (= pIdx 0) (setq srcDetail "StartPoint") (setq srcDetail "EndPoint")) ) (setq gathered (cons (list ent type p srcID srcType srcDetail) gathered)) ) ) (setq pIdx (1+ pIdx)) ) ) (if (not (member type skippedTypes)) (setq skippedTypes (cons type skippedTypes)) ) ) ) (setq gathered (reverse gathered)) ;; PHASE 2: Apply Advanced Sorting (cond ((= sortMethod "1") ; Left to Right (setq gathered (vl-sort gathered '(lambda (a b) (< (car (nth 2 a)) (car (nth 2 b))))))) ((= sortMethod "2") ; Top to Bottom (setq gathered (vl-sort gathered '(lambda (a b) (> (cadr (nth 2 a)) (cadr (nth 2 b))))))) ((= sortMethod "3") ; Along a Path (setq pathEnt nil) (princ "\n=== PATH SORTING ACTIVATED ===") (princ "\nSelect a path curve (Line, Polyline, Spline) to sort along, or press Enter to draw one: ") (setq selPath (ssget "_+.:S:E" '((0 . "LINE,*POLYLINE,SPLINE")))) (if selPath (setq pathEnt (vlax-ename->vla-object (ssname selPath 0))) (progn (princ "\nDrawing path... Use PLINE command (Press Enter or Esc when finished drawing): ") (vl-cmdf "_.PLINE") (while (> (getvar "CMDACTIVE") 0) (vl-cmdf pause)) (if (entlast) (setq pathEnt (vlax-ename->vla-object (entlast)))) ) ) (if pathEnt (progn (princ "\nPath generated successfully. Sorting points...") (setq gathered (vl-sort gathered '(lambda (a b) (< (get-dist-on-curve pathEnt (nth 2 a)) (get-dist-on-curve pathEnt (nth 2 b)))))) ) (princ "\nNo valid path provided. Falling back to default selection order.") ) ) ) ;; PHASE 2.5: Keep closed-element points successive ;; Whatever the sort method (Default, X, Y, or Path), all points of a ;; closed element are numbered one after another before the next element. (if closedEnts (setq gathered (EXT:regroup-closed gathered closedEnts)) ) ;; PHASE 3: Process, Number, and Write Outputs (setq idx start-num) (if (member "CSV" outTypes) (setq fhCSV (open (strcat baseName ".csv") "w"))) (if (member "TXT" outTypes) (setq fhTXT (open (strcat baseName ".txt") "w"))) (if (member "GSI" outTypes) (setq fhGSI (open (strcat baseName ".gsi") "w"))) (if fhCSV (write-line "ID,Type,X,Y,Z" fhCSV)) (foreach item gathered (setq ent (nth 0 item) type (nth 1 item) p (nth 2 item) srcID (nth 3 item) srcType (nth 4 item) srcDetail (nth 5 item)) (setq txtID nil ptID nil) (if (= insPt "Yes") (setq ptID (draw-marker-point p))) (if (= insNum "Yes") (setq txtID (draw-number idx p))) (if (= makeTable "Yes") (setq tableData (cons (list idx (car p) (cadr p) (caddr p) txtID ptID srcID srcType srcDetail) tableData)) ) (if fhCSV (write-line (strcat (itoa idx) "," type "," (rtos (car p) 2 4) "," (rtos (cadr p) 2 4) "," (rtos (caddr p) 2 4)) fhCSV)) (if fhTXT (write-line (strcat (itoa idx) "\t" (rtos (car p) 2 4) "\t" (rtos (cadr p) 2 4) "\t" (rtos (caddr p) 2 4)) fhTXT)) (if fhGSI (write-line (gsi-format p idx) fhGSI)) (setq idx (+ idx incr) count (1+ count)) ) (if fhCSV (close fhCSV)) (if fhTXT (close fhTXT)) (if fhGSI (close fhGSI)) (if (and (= makeTable "Yes") tableData) (make-coord-tables (reverse tableData) maxRows (cond ((> (getvar "TEXTSIZE") 0.0) (getvar "TEXTSIZE")) (T 2.5))) ) (if (= count 0) (if skippedTypes (progn (setq typeStr (car skippedTypes)) (foreach st (cdr skippedTypes) (setq typeStr (strcat typeStr ", " st))) (alert (strcat "0 points exported!\n\nThe objects you selected are: [" typeStr "]\nNone of these match the entity types you checked in the dialog. Please try again.")) ) ) ) count ) ;; ============================ ;; MAIN COMMAND: EXTCOORD ;; ============================ (defun c:EXTCOORD ( / ui-data allowedTypes outTypes insPt insNum makeTable start-num incr maxRows sortMethod selectionFilter ss lst fname baseName total defExt defPath i) (vl-load-com) (setq ui-data (show-extcoord-dialog)) (if (null ui-data) (progn (princ "\nCommand cancelled.") (exit)) ) (setq allowedTypes (nth 0 ui-data) outTypes (nth 1 ui-data) insPt (nth 2 ui-data) insNum (nth 3 ui-data) makeTable (nth 4 ui-data) start-num (nth 5 ui-data) incr (nth 6 ui-data) maxRows (nth 7 ui-data) sortMethod (nth 8 ui-data)) (if (or (null allowedTypes) (= (length allowedTypes) 0)) (progn (alert "No entity types selected!") (exit)) ) (setq selectionFilter (EXT:selection-filter allowedTypes)) (princ "\nSelect objects to export...") (if (setq ss (ssget selectionFilter)) (progn (setq lst '() i 0) (repeat (sslength ss) (setq lst (cons (ssname ss i) lst)) (setq i (1+ i))) (if (null outTypes) (progn (setq total (process-entities (reverse lst) allowedTypes start-num incr outTypes "" insPt insNum makeTable maxRows sortMethod)) (setq *extcoord-last-num* (+ start-num (* total incr))) (EXT:set-setting "EXTCOORD_START" (itoa *extcoord-last-num*)) (princ (strcat "\nSUCCESS: " (itoa total) " points processed (No external files exported).")) ) (progn (setq defExt (cond ((member "CSV" outTypes) "csv") ((member "TXT" outTypes) "txt") ((member "GSI" outTypes) "gsi") (T "csv"))) (setq defPath (if *extcoord-last-dir* (strcat *extcoord-last-dir* "\\") "")) (setq fname (getfiled "Save Export As (Base Name)" defPath defExt 1)) (if fname (progn (setq *extcoord-last-dir* (vl-filename-directory fname)) (setq baseName (vl-filename-directory fname) baseName (strcat baseName "\\" (vl-filename-base fname))) (setq total (process-entities (reverse lst) allowedTypes start-num incr outTypes baseName insPt insNum makeTable maxRows sortMethod)) (setq *extcoord-last-num* (+ start-num (* total incr))) (EXT:set-setting "EXTCOORD_START" (itoa *extcoord-last-num*)) (princ (strcat "\nSUCCESS: " (itoa total) " points processed.")) (if (> total 0) (startapp "explorer" (vl-filename-directory fname))) ) (princ "\nExport cancelled (No save file selected).") ) ) ) ) (princ "\nNothing selected.") ) (princ) ) (princ "\nEXTCOORD Ultimate Dynamic Edition loaded. Type EXTCOORD to run.") (princ)