;;; ================================================================
;;; COLPLACE FINAL v8.0
;;; Smart metric column placement as REAL AutoCAD blocks with attributes
;;;
;;; Commands:
;;;   COLPLACE / CP  - create columns
;;;   COLEDIT        - edit a COLPLACE column using the same dialog
;;;   CPTEST         - create a 400x400 mm test block
;;;   CPDIAG         - diagnostics
;;;
;;; Key features:
;;; - Every column is a real BlockReference.
;;; - Every placed column gets its own unique block definition.
;;; - Column ID is a real editable Attribute (tag = COL_ID).
;;; - Input unit selector affects entered values: mm / cm / m.
;;; - Drawing unit is auto-detected from INSUNITS; unitless assumes mm.
;;; - Hatch preview is shown in DCL.
;;; ================================================================

(vl-load-com)

(setq *cp10-app* "COLPLACE_V10")
(setq *cp10-counter* 0)

(setq *cp10-last*
 '(
   ("MAT" . "Concrete")
   ("SEC" . "Rectangular")
   ("PROFILE" . "IPE 300")
   ("W" . "400")
   ("D" . "400")
   ("THICK" . "10")
   ("DIAM" . "400")
   ("INPUTUNIT" . "mm")
   ("HATCHON" . "0")
   ("HATCH" . "ANSI31")
   ("HATCHSIZE" . "10")
   ("HANGLE" . "45")
   ("ROT" . "0")
   ("CANG" . "0")
   ("MULTI" . "1")
   ("GRIDMODE" . "0")
   ("TAGON" . "1")
   ("PREFIX" . "C")
   ("START" . "1")
   ("TXTH" . "25")
 )
)

(setq *cp10-ipe*
 '(
   ("IPE 80" 80.0 46.0 3.8 5.2)
   ("IPE 100" 100.0 55.0 4.1 5.7)
   ("IPE 120" 120.0 64.0 4.4 6.3)
   ("IPE 140" 140.0 73.0 4.7 6.9)
   ("IPE 160" 160.0 82.0 5.0 7.4)
   ("IPE 180" 180.0 91.0 5.3 8.0)
   ("IPE 200" 200.0 100.0 5.6 8.5)
   ("IPE 220" 220.0 110.0 5.9 9.2)
   ("IPE 240" 240.0 120.0 6.2 9.8)
   ("IPE 270" 270.0 135.0 6.6 10.2)
   ("IPE 300" 300.0 150.0 7.1 10.7)
   ("IPE 330" 330.0 160.0 7.5 11.5)
   ("IPE 360" 360.0 170.0 8.0 12.7)
   ("IPE 400" 400.0 180.0 8.6 13.5)
   ("IPE 450" 450.0 190.0 9.4 14.6)
   ("IPE 500" 500.0 200.0 10.2 16.0)
   ("IPE 550" 550.0 210.0 11.1 17.2)
   ("IPE 600" 600.0 220.0 12.0 19.0)
 )
)

;; -------------------- basic helpers --------------------------------

(defun cp10:get (key al default / pair)
  (if (setq pair (assoc key al)) (cdr pair) default)
)

(defun cp10:set (key val al / pair)
  (if (setq pair (assoc key al))
    (subst (cons key val) pair al)
    (cons (cons key val) al)
  )
)

(defun cp10:real (s default)
  (if (and s (/= s "")) (atof s) default)
)

(defun cp10:int (s default)
  (if (and s (/= s "")) (atoi s) default)
)

(defun cp10:deg->rad (deg)
  (* pi (/ deg 180.0))
)

(defun cp10:rad->deg (ang)
  (* 180.0 (/ ang pi))
)

(defun cp10:format-number (val / s)
  (setq s (rtos val 2 4))
  (while (and (> (strlen s) 1)
              (= (substr s (strlen s) 1) "0")
              (vl-string-search "." s))
    (setq s (substr s 1 (1- (strlen s))))
  )
  (if (= (substr s (strlen s) 1) ".")
    (setq s (substr s 1 (1- (strlen s))))
  )
  s
)

(defun cp10:input-to-mm-factor (unit)
  (cond
    ((= unit "mm") 1.0)
    ((= unit "cm") 10.0)
    ((= unit "m") 1000.0)
    (T 1.0)
  )
)

(defun cp10:drawing-unit (/ u)
  (setq u (getvar "INSUNITS"))
  (cond
    ((= u 4) "mm")
    ((= u 5) "cm")
    ((= u 6) "m")
    (T "mm")
  )
)

(defun cp10:mm-to-drawing-factor (/ unit)
  (setq unit (cp10:drawing-unit))
  (cond
    ((= unit "mm") 1.0)
    ((= unit "cm") 0.1)
    ((= unit "m") 0.001)
    (T 1.0)
  )
)

(defun cp10:input->du (val inputUnit)
  (* val
     (cp10:input-to-mm-factor inputUnit)
     (cp10:mm-to-drawing-factor))
)

(defun cp10:mm->input (mm inputUnit)
  (/ mm (cp10:input-to-mm-factor inputUnit))
)

(defun cp10:convert-input-value (value oldUnit newUnit)
  (/ (* value (cp10:input-to-mm-factor oldUnit))
     (cp10:input-to-mm-factor newUnit))
)

(defun cp10:ensure-layer (name color)
  (if (not (tblsearch "LAYER" name))
    (entmakex
      (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
        (cons 2 name)
        '(70 . 0)
        (cons 62 color)
        '(6 . "Continuous")
      )
    )
  )
)

(defun cp10:setup-layers ()
  (cp10:ensure-layer "S-COL" 7)
  (cp10:ensure-layer "S-COL-HATCH" 8)
  (cp10:ensure-layer "S-COL-TEXT" 2)
)

(defun cp10:doc ()
  (vla-get-ActiveDocument (vlax-get-acad-object))
)

(defun cp10:blocks ()
  (vla-get-Blocks (cp10:doc))
)

(defun cp10:current-space ()
  (if (and (= (getvar "TILEMODE") 0) (= (getvar "CVPORT") 1))
    (vla-get-PaperSpace (cp10:doc))
    (vla-get-ModelSpace (cp10:doc))
  )
)

(defun cp10:ipe-data (name / pair)
  (if (setq pair (assoc name *cp10-ipe*)) (cdr pair))
)

(defun cp10:unique-block-name (/ stamp name)
  (setq *cp10-counter* (1+ *cp10-counter*))
  (setq stamp
    (vl-string-translate
      "."
      "_"
      (rtos (getvar "CDATE") 2 8)
    )
  )
  (setq name
    (strcat "CP_COL_" stamp "_" (itoa *cp10-counter*))
  )
  name
)

;; -------------------- arrays / block geometry ----------------------

(defun cp10:double-array (numbers / sa)
  (setq sa
    (vlax-make-safearray
      vlax-vbDouble
      (cons 0 (1- (length numbers)))
    )
  )
  (vlax-safearray-fill sa numbers)
  sa
)

(defun cp10:poly-in-block (blockObj pts layer / flat obj)
  ;; pts = ((x y) ...)
  (setq flat '())
  (foreach pt pts
    (setq flat (append flat (list (car pt) (cadr pt))))
  )
  (setq obj
    (vla-AddLightWeightPolyline
      blockObj
      (cp10:double-array flat)
    )
  )
  (vla-put-Closed obj :vlax-true)
  (vla-put-Layer obj layer)
  obj
)

(defun cp10:circle-in-block (blockObj center radius layer / obj)
  (setq obj
    (vla-AddCircle
      blockObj
      (vlax-3d-point center)
      radius
    )
  )
  (vla-put-Layer obj layer)
  obj
)

(defun cp10:rect-points (width depth)
  (list
    (list (- (/ width 2.0)) (- (/ depth 2.0)))
    (list (/ width 2.0) (- (/ depth 2.0)))
    (list (/ width 2.0) (/ depth 2.0))
    (list (- (/ width 2.0)) (/ depth 2.0))
  )
)

(defun cp10:ipe-points (height flangeWidth webThick flangeThick / xb xw yh yi)
  (setq xb (/ flangeWidth 2.0)
        xw (/ webThick 2.0)
        yh (/ height 2.0)
        yi (- yh flangeThick))
  (list
    (list (- xb) (- yh))
    (list xb (- yh))
    (list xb (- yi))
    (list xw (- yi))
    (list xw yi)
    (list xb yi)
    (list xb yh)
    (list (- xb) yh)
    (list (- xb) yi)
    (list (- xw) yi)
    (list (- xw) (- yi))
    (list (- xb) (- yi))
  )
)

(defun cp10:hatch-in-block (blockObj boundary pattern scale angle / hatchObj arr loopResult)
  ;; Compatibility-first hatch creation.
  ;; Intentionally uses NO legacy hatch-evaluation method and NO Update method.
  ;; If hatch fails, NIL is returned and column/block creation continues.

  (setq hatchObj
    (vl-catch-all-apply
      '(lambda ()
         (vla-AddHatch blockObj 0 pattern :vlax-true)
       )
    )
  )

  (if (vl-catch-all-error-p hatchObj)
    nil
    (progn
      (setq arr (vlax-make-safearray vlax-vbObject '(0 . 0)))
      (vlax-safearray-put-element arr 0 boundary)

      (setq loopResult
        (vl-catch-all-apply
          'vla-AppendOuterLoop
          (list hatchObj arr)
        )
      )

      (if (vl-catch-all-error-p loopResult)
        (progn
          (vl-catch-all-apply 'vla-Delete (list hatchObj))
          nil
        )
        (progn
          (vl-catch-all-apply
            'vla-put-Layer
            (list hatchObj "S-COL-HATCH")
          )

          (if (/= (strcase pattern) "SOLID")
            (progn
              (vl-catch-all-apply
                'vla-put-PatternScale
                (list hatchObj scale)
              )
              (vl-catch-all-apply
                'vla-put-PatternAngle
                (list hatchObj angle)
              )
            )
          )

          ;; A document regen is enough to refresh supported hatch objects.
          (vl-catch-all-apply
            'vla-Regen
            (list (cp10:doc) 1)
          )

          hatchObj
        )
      )
    )
  )
)

(defun cp10:add-id-attdef (blockObj textHeight width depth / attPt attDef)
  (setq attPt
    (vlax-3d-point
      (list
        (+ (/ width 2.0) (* textHeight 0.55))
        (+ (/ depth 2.0) (* textHeight 0.55))
        0.0
      )
    )
  )

  (setq attDef
    (vla-AddAttribute
      blockObj
      textHeight
      0
      "Column ID"
      attPt
      "COL_ID"
      "C01"
    )
  )
  (vla-put-Layer attDef "S-COL-TEXT")
  attDef
)

(defun cp10:create-block-definition (cfg / blockName blockObj inputUnit sec profile
                                         width depth wallThick diameter ipe
                                         outline inner hatchPattern hatchSize hatchAngle
                                         textHeight)
  (setq inputUnit (cp10:get "INPUTUNIT" cfg "mm"))
  (setq sec (cp10:get "SEC" cfg "Rectangular"))
  (setq profile (cp10:get "PROFILE" cfg "IPE 300"))

  (setq width
    (cp10:input->du
      (cp10:real (cp10:get "W" cfg "400") 400.0)
      inputUnit
    )
  )
  (setq depth
    (cp10:input->du
      (cp10:real (cp10:get "D" cfg "400") 400.0)
      inputUnit
    )
  )
  (setq wallThick
    (cp10:input->du
      (cp10:real (cp10:get "THICK" cfg "10") 10.0)
      inputUnit
    )
  )
  (setq diameter
    (cp10:input->du
      (cp10:real (cp10:get "DIAM" cfg "400") 400.0)
      inputUnit
    )
  )
  (setq hatchSize
    (cp10:input->du
      (cp10:real (cp10:get "HATCHSIZE" cfg "10") 10.0)
      inputUnit
    )
  )
  (setq hatchAngle
    (cp10:deg->rad
      (cp10:real (cp10:get "HANGLE" cfg "45") 45.0)
    )
  )
  (setq hatchPattern (cp10:get "HATCH" cfg "ANSI31"))
  (setq textHeight
    (cp10:input->du
      (cp10:real (cp10:get "TXTH" cfg "25") 25.0)
      inputUnit
    )
  )

  (setq blockName (cp10:unique-block-name))
  (setq blockObj
    (vla-Add
      (cp10:blocks)
      (vlax-3d-point '(0.0 0.0 0.0))
      blockName
    )
  )

  (setq outline nil inner nil)

  (cond
    ((= sec "IPE")
      (setq ipe (cp10:ipe-data profile))
      (if ipe
        (progn
          ;; IPE database is intrinsically in mm
          (setq depth
            (* (nth 0 ipe) (cp10:mm-to-drawing-factor))
          )
          (setq width
            (* (nth 1 ipe) (cp10:mm-to-drawing-factor))
          )
          (setq outline
            (cp10:poly-in-block
              blockObj
              (cp10:ipe-points
                (* (nth 0 ipe) (cp10:mm-to-drawing-factor))
                (* (nth 1 ipe) (cp10:mm-to-drawing-factor))
                (* (nth 2 ipe) (cp10:mm-to-drawing-factor))
                (* (nth 3 ipe) (cp10:mm-to-drawing-factor))
              )
              "S-COL"
            )
          )
        )
      )
    )

    ((= sec "Circular")
      (setq width diameter depth diameter)
      (setq outline
        (cp10:circle-in-block
          blockObj
          '(0.0 0.0 0.0)
          (/ diameter 2.0)
          "S-COL"
        )
      )
    )

    ((= sec "CHS")
      (setq width diameter depth diameter)
      (setq outline
        (cp10:circle-in-block
          blockObj
          '(0.0 0.0 0.0)
          (/ diameter 2.0)
          "S-COL"
        )
      )
      (setq inner
        (cp10:circle-in-block
          blockObj
          '(0.0 0.0 0.0)
          (max 0.000001 (- (/ diameter 2.0) wallThick))
          "S-COL"
        )
      )
    )

    ((= sec "Square")
      (setq depth width)
      (setq outline
        (cp10:poly-in-block
          blockObj
          (cp10:rect-points width width)
          "S-COL"
        )
      )
    )

    ((member sec '("BOX" "CFT"))
      (setq outline
        (cp10:poly-in-block
          blockObj
          (cp10:rect-points width depth)
          "S-COL"
        )
      )
      (setq inner
        (cp10:poly-in-block
          blockObj
          (cp10:rect-points
            (max 0.000001 (- width (* 2.0 wallThick)))
            (max 0.000001 (- depth (* 2.0 wallThick)))
          )
          "S-COL"
        )
      )
    )

    (T
      (setq outline
        (cp10:poly-in-block
          blockObj
          (cp10:rect-points width depth)
          "S-COL"
        )
      )
    )
  )

  ;; Hatch
  (if (= (cp10:get "HATCHON" cfg "0") "1")
    (cond
      ((= sec "CFT")
        (if inner
          (cp10:hatch-in-block
            blockObj inner hatchPattern hatchSize hatchAngle
          )
        )
      )
      ((not (member sec '("BOX" "CHS")))
        (if outline
          (cp10:hatch-in-block
            blockObj outline hatchPattern hatchSize hatchAngle
          )
        )
      )
    )
  )

  ;; Real Attribute Definition
  (if (= (cp10:get "TAGON" cfg "1") "1")
    (cp10:add-id-attdef
      blockObj
      textHeight
      width
      depth
    )
  )

  (list blockName blockObj)
)

;; -------------------- xdata ----------------------------------------

(defun cp10:ensure-regapp ()
  (if (not (tblsearch "APPID" *cp10-app*))
    (regapp *cp10-app*)
  )
)

(defun cp10:xdata-pairs (cfg blockName / keys out)
  (setq keys
    '(
      "MAT" "SEC" "PROFILE" "W" "D" "THICK" "DIAM"
      "INPUTUNIT" "HATCHON" "HATCH" "HATCHSIZE" "HANGLE"
      "ROT" "CANG" "GRIDMODE" "TAGON" "PREFIX" "START" "TXTH"
    )
  )
  (setq out
    (list
      (cons "BLOCKNAME" blockName)
    )
  )
  (foreach key keys
    (setq out
      (append out
        (list (cons key (cp10:get key cfg "")))
      )
    )
  )
  out
)

(defun cp10:attach-xdata (ename data / ed xlist)
  (cp10:ensure-regapp)
  (setq xlist
    (mapcar
      '(lambda (pair)
        (cons 1000
          (strcat (car pair) "=" (cdr pair))
        )
       )
      data
    )
  )
  (setq ed (entget ename))
  (entmod
    (append
      ed
      (list
        (list -3
          (append
            (list *cp10-app*)
            xlist
          )
        )
      )
    )
  )
  (entupd ename)
  ename
)

(defun cp10:read-xdata (ename / ed x raw out item txt pos)
  (setq ed (entget ename (list *cp10-app*)))
  (setq x (assoc -3 ed))
  (setq out '())

  (if x
    (progn
      (setq raw (cdr (cadr x)))
      (foreach item raw
        (if (= (car item) 1000)
          (progn
            (setq txt (cdr item))
            (setq pos (vl-string-search "=" txt))
            (if pos
              (setq out
                (cons
                  (cons
                    (substr txt 1 pos)
                    (substr txt (+ pos 2))
                  )
                  out
                )
              )
            )
          )
        )
      )
    )
  )
  out
)

(defun cp10:is-column-block (ename)
  (and ename
       (= (cdr (assoc 0 (entget ename))) "INSERT")
       (assoc -3 (entget ename (list *cp10-app*))))
)

;; -------------------- attribute operations -------------------------

(defun cp10:get-attributes-list (blockRef / result arr)
  (setq result
    (vl-catch-all-apply
      'vla-GetAttributes
      (list blockRef)
    )
  )
  (if (vl-catch-all-error-p result)
    nil
    (progn
      (setq arr (vlax-variant-value result))
      (vlax-safearray->list arr)
    )
  )
)

(defun cp10:set-id-attribute (blockRef colId / attrs)
  (setq attrs (cp10:get-attributes-list blockRef))
  (foreach att attrs
    (if (= (strcase (vla-get-TagString att)) "COL_ID")
      (vla-put-TextString att colId)
    )
  )
  colId
)

(defun cp10:get-id-attribute (blockRef / attrs value)
  (setq value "")
  (setq attrs (cp10:get-attributes-list blockRef))
  (foreach att attrs
    (if (= (strcase (vla-get-TagString att)) "COL_ID")
      (setq value (vla-get-TextString att))
    )
  )
  value
)

;; -------------------- insertion ------------------------------------

(defun cp10:insert-column-wcs (cfg wcsPoint rotation colId / blockInfo blockName space blockRef ename)
  (setq blockInfo (cp10:create-block-definition cfg))
  (setq blockName (car blockInfo))
  (setq space (cp10:current-space))

  (setq blockRef
    (vla-InsertBlock
      space
      (vlax-3d-point wcsPoint)
      blockName
      1.0
      1.0
      1.0
      rotation
    )
  )

  (if (= (cp10:get "TAGON" cfg "1") "1")
    (cp10:set-id-attribute blockRef colId)
  )

  (setq ename (vlax-vla-object->ename blockRef))
  (cp10:attach-xdata
    ename
    (cp10:xdata-pairs cfg blockName)
  )
  blockRef
)

(defun cp10:insert-column-ucs (cfg ucsPoint rotation colId)
  (cp10:insert-column-wcs
    cfg
    (trans ucsPoint 1 0)
    rotation
    colId
  )
)

;; -------------------- DCL UI ---------------------------------------

(setq *cp10-mats* '("Concrete" "Steel"))
(setq *cp10-input-units* '("mm" "cm" "m"))
(setq *cp10-secs* nil)
(setq *cp10-profiles* nil)
(setq *cp10-ui* nil)
(setq *cp10-ui-unit* "mm")

(defun cp10:sections (mat)
  (if (= mat "Steel")
    '("IPE" "BOX" "CFT" "CHS")
    '("Rectangular" "Square" "Circular")
  )
)

(defun cp10:profiles (sec)
  (if (= sec "IPE")
    (mapcar 'car *cp10-ipe*)
    '("-")
  )
)

(defun cp10:popup-set (key items selected / idx pos)
  (start_list key)
  (mapcar 'add_list items)
  (end_list)

  (setq idx 0 pos 0)
  (foreach item items
    (if (= item selected)
      (setq idx pos)
    )
    (setq pos (1+ pos))
  )
  (set_tile key (itoa idx))
)

(defun cp10:popup-get (key items / idx)
  (setq idx (atoi (get_tile key)))
  (if (and (>= idx 0) (< idx (length items)))
    (nth idx items)
    (car items)
  )
)

(defun cp10:convert-tile-unit (tile oldUnit newUnit / text val)
  (setq text (get_tile tile))
  (if (and text (/= text ""))
    (progn
      (setq val (atof text))
      (set_tile
        tile
        (cp10:format-number
          (cp10:convert-input-value
            val oldUnit newUnit
          )
        )
      )
    )
  )
)

(defun cp10:unit-change (/ newUnit oldUnit)
  (setq newUnit
    (cp10:popup-get "inputunit" *cp10-input-units*)
  )
  (setq oldUnit *cp10-ui-unit*)

  (if (/= newUnit oldUnit)
    (progn
      ;; Convert visible values to preserve physical dimensions.
      (foreach tile '("w" "d" "thick" "diam" "hatchsize" "txth")
        (cp10:convert-tile-unit tile oldUnit newUnit)
      )
      (setq *cp10-ui-unit* newUnit)
      (set_tile
        "unitnote"
        (strcat
          "Input values: " newUnit
          " | Drawing: " (cp10:drawing-unit)
        )
      )
      (cp10:preview-section)
    )
  )
)





;; -------------------- SIMPLE SECTION IMAGE PREVIEW -----------------
;; Deliberately mirrors the working Hatch Preview implementation:
;; start_image -> fill_image -> vector_image -> end_image.
;; No slide_image, no temp files, no logical colors, no combined tile.

(defun cp10:section-dim-line (sec profile / unit width depth wallThick diameter ipe)
  (setq unit *cp10-ui-unit*)
  (setq width (if (/= (get_tile "w") "") (get_tile "w") "0"))
  (setq depth (if (/= (get_tile "d") "") (get_tile "d") "0"))
  (setq wallThick (if (/= (get_tile "thick") "") (get_tile "thick") "0"))
  (setq diameter (if (/= (get_tile "diam") "") (get_tile "diam") "0"))

  (cond
    ((= sec "IPE")
      (if (setq ipe (cp10:ipe-data profile))
        (strcat
          profile
          " | H="
          (cp10:format-number (cp10:mm->input (nth 0 ipe) unit))
          " B="
          (cp10:format-number (cp10:mm->input (nth 1 ipe) unit))
          " "
          unit
        )
        profile
      )
    )
    ((= sec "CHS")
      (strcat "CHS | D=" diameter " t=" wallThick " " unit)
    )
    ((= sec "Circular")
      (strcat "Circular | D=" diameter " " unit)
    )
    ((member sec '("BOX" "CFT"))
      (strcat sec " | " width " x " depth " t=" wallThick " " unit)
    )
    ((= sec "Square")
      (strcat "Square | " width " x " width " " unit)
    )
    (T
      (strcat "Rectangular | " width " x " depth " " unit)
    )
  )
)

(defun cp10:pv-circle (cx cy radius color / idx segments step a1 a2 x1 y1 x2 y2)
  (setq idx 0)
  (setq segments 48)
  (setq step (/ (* 2.0 pi) segments))
  (repeat segments
    (setq a1 (* idx step))
    (setq a2 (* (1+ idx) step))
    (setq x1 (fix (+ cx (* radius (cos a1)))))
    (setq y1 (fix (+ cy (* radius (sin a1)))))
    (setq x2 (fix (+ cx (* radius (cos a2)))))
    (setq y2 (fix (+ cy (* radius (sin a2)))))
    (vector_image x1 y1 x2 y2 color)
    (setq idx (1+ idx))
  )
)

(defun cp10:preview-section (/ ww hh sec profile cx cy left right top bottom
                               innerLeft innerRight innerTop innerBottom
                               ipe flangeLeft flangeRight topY bottomY midX
                               offset dimText)
  (setq ww (dimx_tile "sectionpreview"))
  (setq hh (dimy_tile "sectionpreview"))

  (setq sec
    (if *cp10-secs*
      (cp10:popup-get "sec" *cp10-secs*)
      "Rectangular"
    )
  )

  (setq profile
    (if *cp10-profiles*
      (cp10:popup-get "profile" *cp10-profiles*)
      "-"
    )
  )

  (setq cx (fix (/ ww 2)))
  (setq cy (fix (/ hh 2)))

  (start_image "sectionpreview")

  ;; EXACTLY the same background strategy as working Hatch Preview.
  (fill_image 0 0 ww hh 0)

  ;; White frame, also exactly like Hatch Preview.
  (vector_image 1 1 (- ww 2) 1 7)
  (vector_image (- ww 2) 1 (- ww 2) (- hh 2) 7)
  (vector_image (- ww 2) (- hh 2) 1 (- hh 2) 7)
  (vector_image 1 (- hh 2) 1 1 7)

  (cond
    ;; --------------------------------------------------
    ;; IPE: fixed, unmistakable I profile
    ;; --------------------------------------------------
    ((= sec "IPE")
      (setq flangeLeft (fix (* ww 0.22)))
      (setq flangeRight (fix (* ww 0.78)))
      (setq topY (fix (* hh 0.25)))
      (setq bottomY (fix (* hh 0.75)))
      (setq midX cx)

      ;; top flange - 7 pixels thick
      (setq offset -3)
      (repeat 7
        (vector_image flangeLeft (+ topY offset) flangeRight (+ topY offset) 4)
        (setq offset (1+ offset))
      )

      ;; web - 7 pixels thick
      (setq offset -3)
      (repeat 7
        (vector_image (+ midX offset) topY (+ midX offset) bottomY 4)
        (setq offset (1+ offset))
      )

      ;; bottom flange - 7 pixels thick
      (setq offset -3)
      (repeat 7
        (vector_image flangeLeft (+ bottomY offset) flangeRight (+ bottomY offset) 4)
        (setq offset (1+ offset))
      )
    )

    ;; --------------------------------------------------
    ;; BOX
    ;; --------------------------------------------------
    ((= sec "BOX")
      (setq left (fix (* ww 0.24)))
      (setq right (fix (* ww 0.76)))
      (setq top (fix (* hh 0.20)))
      (setq bottom (fix (* hh 0.80)))

      (vector_image left top right top 4)
      (vector_image right top right bottom 4)
      (vector_image right bottom left bottom 4)
      (vector_image left bottom left top 4)

      (setq innerLeft (fix (* ww 0.34)))
      (setq innerRight (fix (* ww 0.66)))
      (setq innerTop (fix (* hh 0.32)))
      (setq innerBottom (fix (* hh 0.68)))

      (vector_image innerLeft innerTop innerRight innerTop 7)
      (vector_image innerRight innerTop innerRight innerBottom 7)
      (vector_image innerRight innerBottom innerLeft innerBottom 7)
      (vector_image innerLeft innerBottom innerLeft innerTop 7)
    )

    ;; --------------------------------------------------
    ;; CFT
    ;; --------------------------------------------------
    ((= sec "CFT")
      (setq left (fix (* ww 0.24)))
      (setq right (fix (* ww 0.76)))
      (setq top (fix (* hh 0.20)))
      (setq bottom (fix (* hh 0.80)))

      (vector_image left top right top 4)
      (vector_image right top right bottom 4)
      (vector_image right bottom left bottom 4)
      (vector_image left bottom left top 4)

      (setq innerLeft (fix (* ww 0.34)))
      (setq innerRight (fix (* ww 0.66)))
      (setq innerTop (fix (* hh 0.32)))
      (setq innerBottom (fix (* hh 0.68)))

      (vector_image innerLeft innerTop innerRight innerTop 7)
      (vector_image innerRight innerTop innerRight innerBottom 7)
      (vector_image innerRight innerBottom innerLeft innerBottom 7)
      (vector_image innerLeft innerBottom innerLeft innerTop 7)

      ;; concrete core X
      (vector_image innerLeft innerTop innerRight innerBottom 2)
      (vector_image innerLeft innerBottom innerRight innerTop 2)
    )

    ;; --------------------------------------------------
    ;; CHS
    ;; --------------------------------------------------
    ((= sec "CHS")
      (cp10:pv-circle cx cy (fix (* (min ww hh) 0.30)) 4)
      (cp10:pv-circle cx cy (fix (* (min ww hh) 0.21)) 7)
    )

    ;; --------------------------------------------------
    ;; Circular concrete
    ;; --------------------------------------------------
    ((= sec "Circular")
      (cp10:pv-circle cx cy (fix (* (min ww hh) 0.30)) 4)
      (vector_image (- cx 20) cy (+ cx 20) cy 7)
      (vector_image cx (- cy 20) cx (+ cy 20) 7)
    )

    ;; --------------------------------------------------
    ;; Square concrete
    ;; --------------------------------------------------
    ((= sec "Square")
      (setq left (fix (* ww 0.31)))
      (setq right (fix (* ww 0.69)))
      (setq top (fix (* hh 0.20)))
      (setq bottom (fix (* hh 0.80)))

      (vector_image left top right top 4)
      (vector_image right top right bottom 4)
      (vector_image right bottom left bottom 4)
      (vector_image left bottom left top 4)
      (vector_image left top right bottom 7)
      (vector_image left bottom right top 7)
    )

    ;; --------------------------------------------------
    ;; Rectangular concrete
    ;; --------------------------------------------------
    (T
      (setq left (fix (* ww 0.20)))
      (setq right (fix (* ww 0.80)))
      (setq top (fix (* hh 0.30)))
      (setq bottom (fix (* hh 0.70)))

      (vector_image left top right top 4)
      (vector_image right top right bottom 4)
      (vector_image right bottom left bottom 4)
      (vector_image left bottom left top 4)
      (vector_image left top right bottom 7)
      (vector_image left bottom right top 7)
    )
  )

  (end_image)

  (set_tile
    "sectionpreviewname"
    (strcat
      "Section Preview: "
      sec
      (if (= sec "IPE") (strcat " / " profile) "")
    )
  )

  (setq dimText (cp10:section-dim-line sec profile))
  (set_tile "sectionpreviewdims" dimText)
)


(defun cp10:preview-hatch (pattern / ww hh xx)
  (setq ww (dimx_tile "preview"))
  (setq hh (dimy_tile "preview"))

  (start_image "preview")
  (fill_image 0 0 ww hh 0)

  ;; frame
  (vector_image 1 1 (- ww 2) 1 7)
  (vector_image (- ww 2) 1 (- ww 2) (- hh 2) 7)
  (vector_image (- ww 2) (- hh 2) 1 (- hh 2) 7)
  (vector_image 1 (- hh 2) 1 1 7)

  (cond
    ((= pattern "SOLID")
      (fill_image 5 5 (- ww 10) (- hh 10) 8)
    )

    ((= pattern "AR-CONC")
      (vector_image 8 10 20 17 2)
      (vector_image 20 17 12 26 2)
      (vector_image 32 8 43 15 3)
      (vector_image 43 15 34 23 3)
      (vector_image 53 19 65 28 7)
      (vector_image 65 28 54 36 7)
      (vector_image 13 39 25 48 3)
      (vector_image 25 48 11 55 3)
      (vector_image 42 39 52 49 2)
      (vector_image 52 49 39 56 2)
    )

    ((= pattern "ANSI32")
      (setq xx (- hh))
      (while (< xx ww)
        (vector_image xx hh (+ xx hh) 0 2)
        (vector_image (+ xx 5) hh (+ xx hh 5) 0 7)
        (setq xx (+ xx 14))
      )
    )

    ((= pattern "ANSI33")
      (setq xx (- hh))
      (while (< xx ww)
        (vector_image xx hh (+ xx hh) 0 3)
        (vector_image xx 0 (+ xx hh) hh 3)
        (setq xx (+ xx 16))
      )
    )

    ((= pattern "AR-SAND")
      (setq xx 8)
      (while (< xx (- ww 6))
        (vector_image xx 12 (+ xx 1) 12 2)
        (vector_image (+ xx 5) 27 (+ xx 6) 27 7)
        (vector_image (+ xx 2) 43 (+ xx 3) 43 3)
        (setq xx (+ xx 15))
      )
    )

    (T
      ;; ANSI31
      (setq xx (- hh))
      (while (< xx ww)
        (vector_image xx hh (+ xx hh) 0 7)
        (setq xx (+ xx 12))
      )
    )
  )

  (end_image)
  (set_tile "previewname" (strcat "Preview: " pattern))
)

(defun cp10:refresh (/ mat sec profile ipe inputUnit)
  (setq mat (cp10:popup-get "mat" *cp10-mats*))
  (setq *cp10-secs* (cp10:sections mat))

  (setq sec (cp10:get "SEC" *cp10-ui* (car *cp10-secs*)))
  (if (not (member sec *cp10-secs*))
    (setq sec (car *cp10-secs*))
  )
  (cp10:popup-set "sec" *cp10-secs* sec)

  (setq *cp10-profiles* (cp10:profiles sec))
  (setq profile
    (cp10:get "PROFILE" *cp10-ui* (car *cp10-profiles*))
  )
  (if (not (member profile *cp10-profiles*))
    (setq profile (car *cp10-profiles*))
  )
  (cp10:popup-set "profile" *cp10-profiles* profile)

  (mode_tile "profile" (if (= sec "IPE") 0 1))
  (mode_tile "w" (if (member sec '("Rectangular" "Square" "BOX" "CFT")) 0 1))
  (mode_tile "d" (if (member sec '("Rectangular" "BOX" "CFT")) 0 1))
  (mode_tile "thick" (if (member sec '("BOX" "CFT" "CHS")) 0 1))
  (mode_tile "diam" (if (member sec '("Circular" "CHS")) 0 1))

  (setq inputUnit *cp10-ui-unit*)

  ;; IPE dimensions displayed in selected input unit
  (if (= sec "IPE")
    (if (setq ipe (cp10:ipe-data profile))
      (progn
        (set_tile
          "d"
          (cp10:format-number
            (cp10:mm->input (nth 0 ipe) inputUnit)
          )
        )
        (set_tile
          "w"
          (cp10:format-number
            (cp10:mm->input (nth 1 ipe) inputUnit)
          )
        )
      )
    )
  )

  (cp10:preview-section)
)

(defun cp10:sec-change ()
  (setq *cp10-ui*
    (cp10:set
      "SEC"
      (cp10:popup-get "sec" *cp10-secs*)
      *cp10-ui*
    )
  )
  (setq *cp10-ui*
    (cp10:set "PROFILE" "-" *cp10-ui*)
  )
  (cp10:refresh)
)

(defun cp10:profile-change (/ profile ipe)
  (setq profile
    (cp10:popup-get "profile" *cp10-profiles*)
  )
  (setq *cp10-ui*
    (cp10:set "PROFILE" profile *cp10-ui*)
  )

  (if (setq ipe (cp10:ipe-data profile))
    (progn
      (set_tile
        "d"
        (cp10:format-number
          (cp10:mm->input (nth 0 ipe) *cp10-ui-unit*)
        )
      )
      (set_tile
        "w"
        (cp10:format-number
          (cp10:mm->input (nth 1 ipe) *cp10-ui-unit*)
        )
      )
    )
  )
  (cp10:preview-section)
)

(defun cp10:hatch-change (/ pattern)
  (setq pattern
    (cp10:popup-get
      "hatch"
      '("ANSI31" "ANSI32" "ANSI33" "AR-CONC" "AR-SAND" "SOLID")
    )
  )
  (cp10:preview-hatch pattern)
)

(defun cp10:capture ()
  (setq *cp10-ui*
    (list
      (cons "MAT" (cp10:popup-get "mat" *cp10-mats*))
      (cons "SEC" (cp10:popup-get "sec" *cp10-secs*))
      (cons "PROFILE" (cp10:popup-get "profile" *cp10-profiles*))
      (cons "W" (get_tile "w"))
      (cons "D" (get_tile "d"))
      (cons "THICK" (get_tile "thick"))
      (cons "DIAM" (get_tile "diam"))
      (cons "INPUTUNIT"
        (cp10:popup-get "inputunit" *cp10-input-units*)
      )
      (cons "HATCHON" (get_tile "hatchon"))
      (cons "HATCH"
        (cp10:popup-get
          "hatch"
          '("ANSI31" "ANSI32" "ANSI33" "AR-CONC" "AR-SAND" "SOLID")
        )
      )
      (cons "HATCHSIZE" (get_tile "hatchsize"))
      (cons "HANGLE" (get_tile "hangle"))
      (cons "ROT"
        (cp10:popup-get
          "rot"
          '("0" "90" "Custom" "Pick on screen")
        )
      )
      (cons "CANG" (get_tile "cang"))
      (cons "MULTI" (get_tile "multi"))
      (cons "GRIDMODE" (get_tile "gridmode"))
      (cons "TAGON" (get_tile "tagon"))
      (cons "PREFIX" (get_tile "prefix"))
      (cons "START" (get_tile "start"))
      (cons "TXTH" (get_tile "txth"))
    )
  )
)

(defun cp10:write-dcl (/ fn fileHandle)
  (setq fn (vl-filename-mktemp "CP10_" nil ".dcl"))
  (setq fileHandle (open fn "w"))

  (foreach line
    '(
"cp10 : dialog {"
" label = \"Colplace V10, Created by DR Mehrdad Azizi - Vividvisual\";"
" : text { label = \"Colplace V10, Created by DR Mehrdad Azizi\"; alignment = centered; }"
" : text { label = \"Vividvisual\"; alignment = centered; }"
" : text { label = \"Every column is a real editable AutoCAD block.\"; alignment = centered; }"
" spacer;"
" : boxed_column { label = \"1. COLUMN + LIVE PREVIEW\";"
"   : row {"
"     : column {"
"       : popup_list { key = \"mat\"; label = \"System\"; width = 18; }"
"       : popup_list { key = \"sec\"; label = \"Section\"; width = 18; }"
"       : popup_list { key = \"profile\"; label = \"IPE size\"; width = 22; }"
"     }"
"     : column {"
"       : text { key = \"sectionpreviewname\"; label = \"Section preview\"; alignment = centered; }"
"       : image { key = \"sectionpreview\"; width = 30; height = 12; fixed_width = true; fixed_height = true; }"
"       : text { key = \"sectionpreviewdims\"; label = \"\"; alignment = centered; width = 34; }"
"     }"
"   }"
" }"
" : boxed_column { label = \"2. SIZE\";"
"   : row {"
"     : popup_list { key = \"inputunit\"; label = \"Input unit\"; width = 13; }"
"     : text { key = \"unitnote\"; label = \"\"; width = 30; }"
"   }"
"   : row {"
"     : edit_box { key = \"w\"; label = \"Width\"; edit_width = 9; }"
"     : edit_box { key = \"d\"; label = \"Depth\"; edit_width = 9; }"
"   }"
"   : row {"
"     : edit_box { key = \"thick\"; label = \"Thickness\"; edit_width = 9; }"
"     : edit_box { key = \"diam\"; label = \"Diameter\"; edit_width = 9; }"
"   }"
" }"
" : boxed_column { label = \"3. HATCH\";"
"   : row {"
"     : column {"
"       : toggle { key = \"hatchon\"; label = \"Create hatch\"; }"
"       : popup_list { key = \"hatch\"; label = \"Pattern\"; width = 17; }"
"       : edit_box { key = \"hatchsize\"; label = \"Hatch size\"; edit_width = 8; }"
"       : edit_box { key = \"hangle\"; label = \"Angle\"; edit_width = 8; }"
"     }"
"     : column {"
"       : text { key = \"previewname\"; label = \"Preview\"; alignment = centered; }"
"       : image { key = \"preview\"; width = 30; height = 10; fixed_width = true; fixed_height = true; }"
"     }"
"   }"
" }"
" : boxed_column { label = \"4. PLACEMENT\";"
"   : row {"
"     : popup_list { key = \"rot\"; label = \"Rotation\"; width = 18; }"
"     : edit_box { key = \"cang\"; label = \"Custom deg\"; edit_width = 7; }"
"   }"
"   : toggle { key = \"gridmode\"; label = \"Select Grids - place at all grid intersections\"; }"
"   : toggle { key = \"multi\"; label = \"Manual mode: keep placing columns until Enter\"; }"
" }"
" : boxed_column { label = \"COLUMN ID - REAL ATTRIBUTE\";"
"   : toggle { key = \"tagon\"; label = \"Create editable COL_ID attribute\"; }"
"   : row {"
"     : edit_box { key = \"prefix\"; label = \"Prefix\"; edit_width = 5; }"
"     : edit_box { key = \"start\"; label = \"Start\"; edit_width = 5; }"
"     : edit_box { key = \"txth\"; label = \"Text height\"; edit_width = 7; }"
"   }"
" }"
" spacer;"
" ok_cancel;"
"}"
    )
    (write-line line fileHandle)
  )

  (close fileHandle)
  fn
)

(defun cp10:dialog (cfg / fn dclId result sec profile)
  (setq *cp10-ui* cfg)
  (setq *cp10-ui-unit*
    (cp10:get "INPUTUNIT" cfg "mm")
  )

  (setq fn (cp10:write-dcl))
  (setq dclId (load_dialog fn))

  (if (and (> dclId 0) (new_dialog "cp10" dclId))
    (progn
      (cp10:popup-set
        "mat"
        *cp10-mats*
        (cp10:get "MAT" cfg "Concrete")
      )

      (setq *cp10-secs*
        (cp10:sections (cp10:get "MAT" cfg "Concrete"))
      )
      (setq sec
        (cp10:get "SEC" cfg (car *cp10-secs*))
      )
      (if (not (member sec *cp10-secs*))
        (setq sec (car *cp10-secs*))
      )
      (cp10:popup-set "sec" *cp10-secs* sec)

      (setq *cp10-profiles* (cp10:profiles sec))
      (setq profile
        (cp10:get "PROFILE" cfg (car *cp10-profiles*))
      )
      (if (not (member profile *cp10-profiles*))
        (setq profile (car *cp10-profiles*))
      )
      (cp10:popup-set "profile" *cp10-profiles* profile)

      (cp10:popup-set
        "inputunit"
        *cp10-input-units*
        *cp10-ui-unit*
      )

      (set_tile "w" (cp10:get "W" cfg "400"))
      (set_tile "d" (cp10:get "D" cfg "400"))
      (set_tile "thick" (cp10:get "THICK" cfg "10"))
      (set_tile "diam" (cp10:get "DIAM" cfg "400"))

      (set_tile
        "unitnote"
        (strcat
          "Input values: " *cp10-ui-unit*
          " | Drawing: " (cp10:drawing-unit)
        )
      )

      (set_tile "hatchon" (cp10:get "HATCHON" cfg "0"))
      (cp10:popup-set
        "hatch"
        '("ANSI31" "ANSI32" "ANSI33" "AR-CONC" "AR-SAND" "SOLID")
        (cp10:get "HATCH" cfg "ANSI31")
      )
      (set_tile "hatchsize" (cp10:get "HATCHSIZE" cfg "10"))
      (set_tile "hangle" (cp10:get "HANGLE" cfg "45"))

      (cp10:popup-set
        "rot"
        '("0" "90" "Custom" "Pick on screen")
        (cp10:get "ROT" cfg "0")
      )
      (set_tile "cang" (cp10:get "CANG" cfg "0"))
      (set_tile "gridmode" (cp10:get "GRIDMODE" cfg "0"))
      (set_tile "multi" (cp10:get "MULTI" cfg "1"))

      (set_tile "tagon" (cp10:get "TAGON" cfg "1"))
      (set_tile "prefix" (cp10:get "PREFIX" cfg "C"))
      (set_tile "start" (cp10:get "START" cfg "1"))
      (set_tile "txth" (cp10:get "TXTH" cfg "25"))

      (action_tile
        "mat"
        "(setq *cp10-ui* (cp10:set \"MAT\" (cp10:popup-get \"mat\" *cp10-mats*) *cp10-ui*))(cp10:refresh)"
      )
      (action_tile "sec" "(cp10:sec-change)")
      (action_tile "profile" "(cp10:profile-change)")
      (action_tile "inputunit" "(cp10:unit-change)")
      (action_tile "w" "(cp10:preview-section)")
      (action_tile "d" "(cp10:preview-section)")
      (action_tile "thick" "(cp10:preview-section)")
      (action_tile "diam" "(cp10:preview-section)")
      (action_tile "hatch" "(cp10:hatch-change)")
      (action_tile "accept" "(cp10:capture)(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")

      (cp10:refresh)
      (cp10:preview-hatch
        (cp10:get "HATCH" cfg "ANSI31")
      )
      (cp10:preview-section)

      (setq result (start_dialog))
      (unload_dialog dclId)
      (vl-file-delete fn)

      (if (= result 1)
        *cp10-ui*
        nil
      )
    )
    (progn
      (if (> dclId 0) (unload_dialog dclId))
      (if (findfile fn) (vl-file-delete fn))
      nil
    )
  )
)

;; -------------------- placement / editing --------------------------


;; -------------------- grid / axis intersection mode ----------------

(defun cp10:variant->list (value / raw)
  (cond
    ((= (type value) 'VARIANT)
      (setq raw (vlax-variant-value value))
      (if (= (type raw) 'SAFEARRAY)
        (vlax-safearray->list raw)
        raw
      )
    )
    ((= (type value) 'SAFEARRAY)
      (vlax-safearray->list value)
    )
    ((listp value) value)
    (T nil)
  )
)

(defun cp10:flat->points (flat / result)
  (setq result '())
  (while (and flat (caddr flat))
    (setq result
      (cons
        (list
          (car flat)
          (cadr flat)
          (caddr flat)
        )
        result
      )
    )
    (setq flat (cdddr flat))
  )
  (reverse result)
)

(defun cp10:pair-intersections (entity1 entity2 / obj1 obj2 result flat)
  (setq obj1 (vlax-ename->vla-object entity1))
  (setq obj2 (vlax-ename->vla-object entity2))

  ;; acExtendBoth = 3
  ;; This lets finite LINE grid segments behave like true axes.
  (setq result
    (vl-catch-all-apply
      'vlax-invoke
      (list obj1 'IntersectWith obj2 3)
    )
  )

  (if (vl-catch-all-error-p result)
    nil
    (progn
      (setq flat (cp10:variant->list result))
      (if flat
        (cp10:flat->points flat)
        nil
      )
    )
  )
)

(defun cp10:point-near-p (pointA pointB tolerance)
  (<= (distance pointA pointB) tolerance)
)

(defun cp10:add-unique-point (point points tolerance / found)
  (setq found nil)
  (foreach existing points
    (if (cp10:point-near-p point existing tolerance)
      (setq found T)
    )
  )
  (if found
    points
    (cons point points)
  )
)

(defun cp10:grid-intersections (selectionSet / i j ent1 ent2 pts result tolerance)
  (setq result '())

  ;; 0.1 mm expressed in current drawing units.
  (setq tolerance
    (* 0.1 (cp10:mm-to-drawing-factor))
  )
  (if (<= tolerance 0.0)
    (setq tolerance 0.0001)
  )

  (setq i 0)
  (while (< i (sslength selectionSet))
    (setq ent1 (ssname selectionSet i))
    (setq j (1+ i))

    (while (< j (sslength selectionSet))
      (setq ent2 (ssname selectionSet j))
      (setq pts (cp10:pair-intersections ent1 ent2))

      (foreach point pts
        (setq result
          (cp10:add-unique-point point result tolerance)
        )
      )

      (setq j (1+ j))
    )
    (setq i (1+ i))
  )

  result
)

(defun cp10:sort-intersections (points)
  ;; Stable architectural reading order:
  ;; top to bottom, and left to right within each row.
  (vl-sort
    points
    '(lambda (a b)
       (if
         (equal (cadr a) (cadr b) 1e-8)
         (< (car a) (car b))
         (> (cadr a) (cadr b))
       )
     )
  )
)

(defun cp10:select-grids-and-place (cfg number prefix tag / ss points rotation baseUcs colId blockRef)
  (prompt
    "\nSelect ALL project grids/axes (LINE, XLINE, RAY or POLYLINE), then press Enter: "
  )

  (setq ss
    (ssget
      '(
        (-4 . "<OR")
        (0 . "LINE")
        (0 . "XLINE")
        (0 . "RAY")
        (0 . "LWPOLYLINE")
        (0 . "POLYLINE")
        (-4 . "OR>")
       )
    )
  )

  (if (not ss)
    (progn
      (prompt "\nNo grids were selected.")
      number
    )
    (progn
      (setq points
        (cp10:sort-intersections
          (cp10:grid-intersections ss)
        )
      )

      (if (not points)
        (progn
          (prompt "\nNo grid intersections were found.")
          number
        )
        (progn
          ;; One rotation for all grid-generated columns.
          (setq baseUcs (trans (car points) 0 1))
          (setq rotation (cp10:get-angle cfg baseUcs))

          (foreach point points
            (setq colId
              (if tag
                (strcat
                  prefix
                  (if (< number 10) "0" "")
                  (itoa number)
                )
                ""
              )
            )

            (setq blockRef
              (cp10:insert-column-wcs
                cfg
                point
                rotation
                colId
              )
            )

            (if blockRef
              (setq number (1+ number))
            )
          )

          (prompt
            (strcat
              "\nGrid placement complete: "
              (itoa (length points))
              " unique intersections processed."
            )
          )
          number
        )
      )
    )
  )
)

(defun cp10:get-angle (cfg base / mode secondPoint)
  (setq mode (cp10:get "ROT" cfg "0"))
  (cond
    ((= mode "90") (/ pi 2.0))
    ((= mode "Custom")
      (cp10:deg->rad
        (cp10:real (cp10:get "CANG" cfg "0") 0.0)
      )
    )
    ((= mode "Pick on screen")
      (setq secondPoint
        (getpoint base "\nPick rotation direction: ")
      )
      (if secondPoint
        (angle base secondPoint)
        0.0
      )
    )
    (T 0.0)
  )
)

(defun cp10:run (/ *error* cfg pickPoint rotation number prefix colId
                    multi tag gridMode blockRef)
  (defun *error* (msg)
    (if (and msg
             (/= msg "Function cancelled")
             (/= msg "quit / exit abort"))
      (prompt (strcat "\nCOLPLACE ERROR: " msg))
    )
    (princ)
  )

  (cp10:setup-layers)

  (setq cfg (cp10:dialog *cp10-last*))

  (if cfg
    (progn
      (setq *cp10-last* cfg)
      (setq number
        (cp10:int (cp10:get "START" cfg "1") 1)
      )
      (setq prefix (cp10:get "PREFIX" cfg "C"))
      (setq multi (= (cp10:get "MULTI" cfg "1") "1"))
      (setq gridMode (= (cp10:get "GRIDMODE" cfg "0") "1"))
      (setq tag (= (cp10:get "TAGON" cfg "1") "1"))

      (if gridMode
        ;; Automatic placement on every selected-grid intersection.
        (setq number
          (cp10:select-grids-and-place
            cfg number prefix tag
          )
        )

        ;; Manual placement, identical to the working v7 behavior.
        (progn
          (setq pickPoint
            (getpoint "\nClick COLUMN CENTER <Enter to finish>: ")
          )

          (while pickPoint
            (setq rotation
              (cp10:get-angle cfg pickPoint)
            )

            (setq colId
              (if tag
                (strcat
                  prefix
                  (if (< number 10) "0" "")
                  (itoa number)
                )
                ""
              )
            )

            (setq blockRef
              (cp10:insert-column-ucs
                cfg pickPoint rotation colId
              )
            )

            (if blockRef
              (progn
                (prompt
                  (strcat
                    "\nColumn block created"
                    (if (/= colId "")
                      (strcat " | ID = " colId)
                      ""
                    )
                    "."
                  )
                )
                (setq number (1+ number))
              )
              (prompt "\nCOLPLACE ERROR: block could not be created.")
            )

            (if multi
              (setq pickPoint
                (getpoint "\nNext COLUMN CENTER <Enter to finish>: ")
              )
              (setq pickPoint nil)
            )
          )
        )
      )
    )
  )
  (princ)
)

(defun c:COLPLACE10 () (cp10:run))
(defun c:CP10 () (cp10:run))
(defun c:COLPLACE8 () (cp10:run))
(defun c:CP8 () (cp10:run))
(defun c:COLPLACE () (cp10:run))
(defun c:CP () (cp10:run))

(defun c:COLEDIT10 (/ *error* sel ename xdata cfg blockRef oldId insertion rotation newCfg newRef editRotation)
  (defun *error* (msg)
    (if (and msg
             (/= msg "Function cancelled")
             (/= msg "quit / exit abort"))
      (prompt (strcat "\nCOLEDIT ERROR: " msg))
    )
    (princ)
  )

  (setq sel
    (entsel "\nSelect a COLPLACE column block: ")
  )

  (if sel
    (progn
      (setq ename (car sel))

      (if (cp10:is-column-block ename)
        (progn
          (setq xdata (cp10:read-xdata ename))
          (setq cfg
            (list
              (cons "MAT" (cp10:get "MAT" xdata "Concrete"))
              (cons "SEC" (cp10:get "SEC" xdata "Rectangular"))
              (cons "PROFILE" (cp10:get "PROFILE" xdata "IPE 300"))
              (cons "W" (cp10:get "W" xdata "400"))
              (cons "D" (cp10:get "D" xdata "400"))
              (cons "THICK" (cp10:get "THICK" xdata "10"))
              (cons "DIAM" (cp10:get "DIAM" xdata "400"))
              (cons "INPUTUNIT" (cp10:get "INPUTUNIT" xdata "mm"))
              (cons "HATCHON" (cp10:get "HATCHON" xdata "0"))
              (cons "HATCH" (cp10:get "HATCH" xdata "ANSI31"))
              (cons "HATCHSIZE" (cp10:get "HATCHSIZE" xdata "10"))
              (cons "HANGLE" (cp10:get "HANGLE" xdata "45"))
              (cons "ROT" "Custom")
              (cons "CANG" "0")
              (cons "MULTI" "0")
              (cons "GRIDMODE" "0")
              (cons "TAGON" (cp10:get "TAGON" xdata "1"))
              (cons "PREFIX" (cp10:get "PREFIX" xdata "C"))
              (cons "START" (cp10:get "START" xdata "1"))
              (cons "TXTH" (cp10:get "TXTH" xdata "25"))
            )
          )

          (setq blockRef (vlax-ename->vla-object ename))
          (setq oldId (cp10:get-id-attribute blockRef))

          (setq insertion
            (vlax-safearray->list
              (vlax-variant-value
                (vla-get-InsertionPoint blockRef)
              )
            )
          )
          (setq rotation (vla-get-Rotation blockRef))

          ;; Keep actual current rotation.
          (setq cfg
            (cp10:set
              "CANG"
              (cp10:format-number
                (cp10:rad->deg rotation)
              )
              cfg
            )
          )

          (setq newCfg (cp10:dialog cfg))

          (if newCfg
            (progn
              ;; Rebuild as a new unique block, preserving location and current ID.
              ;; Resolve edited rotation at the actual column location.
              (setq editRotation
                (cp10:get-angle
                  newCfg
                  (trans insertion 0 1)
                )
              )

              (setq newRef
                (cp10:insert-column-wcs
                  newCfg
                  insertion
                  editRotation
                  oldId
                )
              )

              (if newRef
                (progn
                  (vla-Delete blockRef)
                  (prompt "\nColumn updated successfully.")
                )
              )
            )
          )
        )
        (prompt "\nSelected object is not a COLPLACE v8 column.")
      )
    )
  )
  (princ)
)

(defun c:COLEDIT ()
  (c:COLEDIT10)
)

(defun c:CP10TEST (/ cfg pt ref)
  (cp10:setup-layers)

  (setq cfg
    '(
      ("MAT" . "Concrete")
      ("SEC" . "Rectangular")
      ("PROFILE" . "-")
      ("W" . "400")
      ("D" . "400")
      ("THICK" . "10")
      ("DIAM" . "400")
      ("INPUTUNIT" . "mm")
      ("HATCHON" . "0")
      ("HATCH" . "ANSI31")
      ("HATCHSIZE" . "10")
      ("HANGLE" . "45")
      ("ROT" . "0")
      ("CANG" . "0")
      ("MULTI" . "0")
      ("GRIDMODE" . "0")
      ("TAGON" . "1")
      ("PREFIX" . "C")
      ("START" . "1")
      ("TXTH" . "25")
    )
  )

  (setq pt
    (getpoint "\nCPTEST: Pick center for 400x400 mm block: ")
  )

  (if pt
    (progn
      (setq ref
        (cp10:insert-column-ucs cfg pt 0.0 "C01")
      )
      (if ref
        (prompt
          "\nCPTEST SUCCESS: real block with editable COL_ID attribute created."
        )
      )
    )
  )
  (princ)
)

(defun c:CPTEST ()
  (c:CP10TEST)
)

(defun c:CP10DIAG ()
  (prompt
    (strcat
      "\n--- COLPLACE v7.0 DIAGNOSTICS ---"
      "\nINSUNITS = " (itoa (getvar "INSUNITS"))
      "\nDrawing unit detected = " (cp10:drawing-unit)
      "\nTILEMODE = " (itoa (getvar "TILEMODE"))
      "\nCVPORT = " (itoa (getvar "CVPORT"))
      "\nCTAB = " (getvar "CTAB")
    )
  )
  (princ)
)


(defun c:CPDIAG ()
  (c:CP10DIAG)
)
















(defun c:CPVER10 ()
  (prompt "\nCOLPLACE VERSION = 10.0 SIMPLE IMAGE PREVIEW")
  (princ)
)

(prompt
  "\n>>> COLPLACE v8.0 FINAL LOADED <<<  Use COLPLACE71 or CP71"
)
(princ)