This LISP routine reads from an IFC file, searches for IFCMapConversion and IFCIUnit parameters, extracts coordinates, rotation, and unit from them, draws helper circles in the drawing, and (in BricsCAD V26) automatically sets the Project Location. Below is a clear, step‑by‑step explanation of what each part of the code does.
To add location data to a IFC file => geo.buildingsmart.nl
🧩 Overview of the functionality in the LISP
The routine command: ReadIFCMapConversion performs several tasks:
- Checks in AutoCAD and BricsCAD whether the file is IFC4 or IFC2x3 and acts accordingly.
- Sets Project Location and Geolocation for BricsCAD BIM.
- Searches an IFC4 file for the line containing
IFCMAPCONVERSION→ extracts X, Y, Z, cosine, sine, and thus the rotation angle. - Searches an IFC2x3 file for comparable lines such as
epset→ extracts X, Y, Z, cosine, sine, and thus the rotation angle. - Searches for the
IFCIUNITline → determines whether the model uses metres or millimetres. - Draws circles around the MapConversion point
- Sets Project Location and Site Location including rotation (BricsCAD only).
- Transfers the EPSG code from the IFC into BricsCAD → this allows you to activate aerial imagery directly (only when units are metres).
Sidenote: BricsCAD is missing EPSG:7415 (NL). Reported for inclusion in a future release.
appload;; ======================================================================
;; UNIFIED IFC MAPCONVERSION PARSER - V20
;; ======================================================================
(vl-load-com)
(defun set-random-color-hash ( / e s c data old62 new62 )
(vl-load-com)
(setq e (entlast))
(if e
(progn
(setq data (entget e))
(setq s 0)
(foreach ch (vl-string->list (vl-princ-to-string e))
(setq s (+ s ch))
)
(setq c (1+ (rem s 10)))
(setq old62 (assoc 62 data))
(setq new62 (cons 62 c))
(if old62
(setq data (subst new62 old62 data))
(setq data (append data (list new62)))
)
(entmod data)
(entupd e)
)
)
(princ)
)
(defun clean-line (s)
(vl-string-trim
" \t\r\n\000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037\ufeff\ua0"
s))
(defun extract-number-after (line key / p start end raw)
(setq p (vl-string-search key line))
(if p
(progn
(setq start (vl-string-search "(" line p))
(setq end (vl-string-search ")" line start))
(if (and start end)
(progn
(setq raw (substr line (+ start 2) (- end start 1)))
(atof raw)
)
)
)
)
)
(defun extract-epsg (line / pos start out ch)
(setq pos (vl-string-search "EPSG:" line))
(if pos
(progn
(setq start (+ pos 5))
(setq out "")
(while (and (< start (strlen line))
(setq ch (substr line (1+ start) 1))
(wcmatch ch "[0-9]"))
(setq out (strcat out ch))
(setq start (1+ start)))
out
)
)
)
(defun ifc-unit->meters (u)
(cond
((= (strcase u) ".METRE.") 1.0)
((= (strcase u) ".MILLIMETRE.") 0.001)
((= (strcase u) ".CENTIMETRE.") 0.01)
((= (strcase u) ".KILOMETRE.") 1000.0)
((= (strcase u) ".FOOT.") 0.3048)
((= (strcase u) ".INCH.") 0.0254)
(T 1.0)
)
)
(defun dwg-units->meters (code)
(cond
((= code 1) 0.0254)
((= code 2) 0.3048)
((= code 4) 0.001)
((= code 5) 0.01)
((= code 6) 1.0)
(T 1.0)
)
)
(defun dwg-units->text (code)
(cond
((= code 1) "inch")
((= code 2) "feet")
((= code 4) "mm")
((= code 5) "cm")
((= code 6) "m")
(T "unknown")
)
)
(defun get-scale-factor (ifc-unit-token / ifc-m dwg-m)
(setq ifc-m (ifc-unit->meters ifc-unit-token))
(setq dwg-m (dwg-units->meters (getvar "INSUNITS")))
(/ ifc-m dwg-m)
)
(defun rot-direction (angle)
(cond
((> angle 0) "CCW")
((< angle 0) "CW")
(T "Geen rotatie"))
)
;; ----------------------------------------------------------------------
;; Arrow drawing: uses ang (radians) + len, via @len<ang syntax
;; ----------------------------------------------------------------------
(defun drawarrow (x y z ang len)
(setq oldSrc (getvar "INSUNITSDEFSOURCE"))
(setq oldTgt (getvar "INSUNITSDEFTARGET"))
(setvar "INSUNITSDEFSOURCE" 0)
(setvar "INSUNITSDEFTARGET" 0)
(progn
(setq base-pt (list x y z))
(setq ang-deg (* ang (/ 180.0 pi)))
(setq vec (strcat "@" (rtos len 2 6) "<" (rtos ang-deg 2 6)))
(command "_.LINE" base-pt vec "")
(set-random-color-hash)
)
(setvar "INSUNITSDEFSOURCE" oldSrc)
(setvar "INSUNITSDEFTARGET" oldTgt)
(princ)
)
;; ======================================================================
;; IFC4 UTILITIES
;; ======================================================================
(defun ifc-split-params (s / out level c token)
(setq out '()
token ""
level 0)
(foreach c (vl-string->list s)
(cond
((= c 40) (setq level (1+ level)) (setq token (strcat token (chr c))))
((= c 41) (setq level (1- level)) (setq token (strcat token (chr c))))
((and (= c 44) (= level 0))
(setq out (cons token out))
(setq token ""))
(t (setq token (strcat token (chr c))))))
(reverse (cons token out))
)
(defun ifc-extract-params (line / a b)
(setq a (vl-string-search "(" line))
(setq b (vl-string-search ")" line a))
(if (and a b)
(substr line (+ a 2) (- b a 1))
)
)
(defun ifc-extract-epsg (line / params first)
(if (wcmatch (strcase line) "*IFCPROJECTEDCRS(*")
(progn
(setq params (ifc-split-params (ifc-extract-params line)))
(setq first (vl-string-trim "'" (nth 0 params)))
(if (wcmatch (strcase first) "EPSG:*")
first
)
)
)
)
;; ======================================================================
;; UNIFIED PARSER ENTRY
;; ======================================================================
(defun c:RIC (/ path file line is4 schema mapline hasCRS u)
;; Reset UCS
(command "_.UCS" "world")
(command "_.PLAN" "")
;; Reset shared variables
(setq east nil
north nil
ortho nil
xabs nil
xord nil
sc nil
epsg nil
x 0.0
y 0.0
z 0.0
rot 0.0
scale 1.0
)
;; Select IFC file (start in DWG folder)
(setq path (getfiled "Select IFC file" (getvar "DWGPREFIX") "ifc" 0))
(if (not path)
(progn (alert "No file selected.") (princ) (return))
)
;; ------------------------------------------------------------
;; Detect IFC schema
;; ------------------------------------------------------------
(setq file (open path "r"))
(setq is4 nil
schema "IFC2x3")
(while (and (not is4) (setq line (read-line file)))
(cond
((wcmatch (strcase line) "*FILE_SCHEMA*IFC4*")
(setq is4 T)
(setq schema "IFC4"))
((wcmatch (strcase line) "*FILE_SCHEMA*IFC2X3*")
(setq is4 nil)
(setq schema "IFC2x3"))
)
)
(close file)
(prompt (strcat "\nDetected IFC schema: " schema))
;; ------------------------------------------------------------
;; IFC4 ³ must contain IfcMapConversion
;; ------------------------------------------------------------
(if is4
(progn
(setq file (open path "r"))
(setq mapline nil)
(while (and (not mapline) (setq line (read-line file)))
(if (wcmatch (strcase line) "*IFCMAPCONVERSION(*")
(setq mapline line)
)
)
(close file)
(if (not mapline)
(progn
(alert
"This IFC4 file does not contain an IfcMapConversion entity.\n\n\
IFC4 requires IfcMapConversion for geolocation.\n\
Cannot continue."
)
(princ)
(return)
)
)
;; OK ³ parse IFC4
(ReadIFC4 path)
)
;; ------------------------------------------------------------
;; IFC2x3 ³ must contain geolocation properties
;; ------------------------------------------------------------
(progn
(setq file (open path "r"))
(setq hasCRS nil)
(while (and (not hasCRS) (setq line (read-line file)))
(setq u (strcase line))
(if (or
(wcmatch u "*TARGETCRS*")
(wcmatch u "*EASTINGS*")
(wcmatch u "*NORTHINGS*")
(wcmatch u "*ORTHOGONALHEIGHT*")
(wcmatch u "*XAXISABSCISSA*")
(wcmatch u "*XAXISORDINATE*")
)
(setq hasCRS T)
)
)
(close file)
(if (not hasCRS)
(progn
(alert
"This IFC2x3 file does not contain required geolocation properties.\n\n\
Required: TargetCRS, Eastings, Northings, OrthogonalHeight,\n\
XAxisAbscissa, XAxisOrdinate.\n\
Cannot continue."
)
(princ)
(return)
)
)
;; OK ³ parse IFC2x3
(ReadIFC2x3 path)
)
)
;; ------------------------------------------------------------
;; Final message
;; ------------------------------------------------------------
(prompt
(strcat
"\nProcessed IFC file: "
(vl-filename-base path)
(vl-filename-extension path)
)
)
(princ)
)
;; ======================================================================
;; IFC2x3 PARSER (V20)
;; ======================================================================
(defun ReadIFC2x3 (path / file raw line east north ortho xabs xord sc epsg
unit prefix params scale x y z cosv sinv rot radius radius1 len ang txt height platform-msg pt cs)
(setq file (open path "r"))
(setq east nil north nil ortho nil xabs nil xord nil sc nil epsg nil)
(setq unit ".METRE.")
(setq prefix nil)
(while (setq raw (read-line file))
(setq line (clean-line raw))
(if (and
(or (wcmatch (strcase line) "*IFCSIUNIT(*")
(wcmatch (strcase line) "*IFCIUNIT(*"))
(wcmatch (strcase line) "*,.LENGTHUNIT.,*")
)
(progn
(setq params (ifc-split-params (ifc-extract-params line)))
(setq prefix (nth 2 params))
(setq unit (nth 3 params))
(cond
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".MILLI."))
(setq unit ".MILLIMETRE."))
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".CENTI."))
(setq unit ".CENTIMETRE."))
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".KILO."))
(setq unit ".KILOMETRE."))
)
)
)
(if (vl-string-search "'Eastings'" line)
(setq east (extract-number-after line "'Eastings'")))
(if (vl-string-search "'Northings'" line)
(setq north (extract-number-after line "'Northings'")))
(if (vl-string-search "'OrthogonalHeight'" line)
(setq ortho (extract-number-after line "'OrthogonalHeight'")))
(if (vl-string-search "'XAxisAbscissa'" line)
(setq xabs (extract-number-after line "'XAxisAbscissa'")))
(if (vl-string-search "'XAxisOrdinate'" line)
(setq xord (extract-number-after line "'XAxisOrdinate'")))
(if (vl-string-search "'Scale'" line)
(setq sc (extract-number-after line "'Scale'")))
(if (and (not epsg)
(vl-string-search "'TargetCRS'" line))
(setq epsg (extract-epsg line)))
)
(close file)
(setq scale (/ 1.0 (dwg-units->meters (getvar "INSUNITS"))))
(setq x (* scale (if east east 0.0)))
(setq y (* scale (if north north 0.0)))
(setq z (* scale (if ortho ortho 0.0)))
;; Rotation from XAxisAbscissa / XAxisOrdinate
(setq cosv (if xabs xabs 1.0))
(setq sinv (if xord xord 0.0))
(setq ang (atan sinv cosv)) ;; radians
(setq rot (* -180.0 (/ ang pi))) ;; degrees (for messages / BricsCAD)
(setq len (* scale 100.0)) ;; arrow length
;; Arrow
(drawarrow x y z (+ ang (/ pi 2)) len)
;; Text label
(setq txt (strcat (vl-filename-base path) ".ifc"))
(setq height (/ len 40.0))
(setq angTextDeg (* ang (/ 180.0 pi))) ;; same angle as arrow, in degrees
(command "_.TEXT" "_J" "TL" (list x y z) height angTextDeg txt)
(prompt
(strcat
"\nx=" (vl-princ-to-string x)
"\ny=" (vl-princ-to-string y)
)
)
;; Circles
(setq radius (* scale 25.0))
(setq radius1 (* scale 660.0))
(command "_.CIRCLE" (list x y z) (rtos radius 2 6))
(set-random-color-hash)
(command "_.CIRCLE" (list x y z) (rtos radius1 2 6))
(set-random-color-hash)
;; ------------------------------------------------------------
;; Create UCS based on IFC rotation and name it after the file
;; ------------------------------------------------------------
(setq ifcName (vl-filename-base path))
(setq ucsName (strcat "UCS_" ifcName))
;; If UCS already exists ³ delete it first
(if (tblsearch "UCS" ucsName)
(command "_.UCS" "DELETE" ucsName)
)
;; Now create the new UCS
(command "_.UCS" "_W")
(command "_.UCS" "_O" (list x y z))
(command "_.UCS" "_Z" angUCS)
(command "_.UCS" "_S" ucsName)
(command "_.PLAN" "")
(command "_.UCS" "_W")
;; ang = IFC angle (radians)
(setq angArrow (+ ang (/ pi 2))) ;; arrow (upward)
(setq angUCS (- angArrow (/ pi 2))) ;; 90° CW from arrow
(setq angUCSdeg (* angUCS (/ 180.0 pi))) ;; degrees
(if (wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
(command "_.ZOOM" "_EN" (entlast) "")
(command "_.ZOOM" "_O" (entlast) "")
)
;; BricsCAD V26 geolocation
(if (and
(wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
(wcmatch (getvar "ACADVER") "26.*")
)
(progn
(setq pt (strcat (rtos x 2 6) "," (rtos y 2 6) "," (rtos z 2 6)))
(setq ang (rtos rot 2 8))
(command "_.SETSURVEYLOCATION" "POINT" pt "angle" ang "")
(command "_.SETSURVEYLOCATION" "CLEAR")
(command "_.SETPROJECTLOCATION" "POINT" pt "angle" ang "")
(command "_.SETSITELOCATION" "POINT" pt "angle" ang "")
(if epsg
(progn
(setq cs (vl-string-subst "" "'" epsg))
(vl-cmdf "-GEOGRAPHICLOCATION" cs)
)
)
)
)
(setq platform-msg
(if (wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
"PROJECTLOCATION and SITELOCATION set"
"North direction drawn"
)
)
(alert
(strcat
"IFC2x3 MapConversion\n"
"\nXYZ (scaled): " (rtos x 2 3) ", " (rtos y 2 3) ", " (rtos z 2 3)
"\nRotation: " (rtos rot 2 8) " (" (rot-direction rot) ")"
"\nEPSG: " (if epsg epsg "Not found")
"\n\n" platform-msg
)
)
)
;; ======================================================================
;; IFC4 PARSER (V20)
;; ======================================================================
(defun ReadIFC4 (path / file line mapline unitline epsg params
x y z cosv sinv rot unit prefix scale radius radius1 cs
len ang txt height platform-msg pt)
(setq file (open path "r"))
(while (setq line (read-line file))
(cond
((wcmatch (strcase line) "*IFCMAPCONVERSION(*")
(setq mapline line))
((and
(or (wcmatch (strcase line) "*IFCSIUNIT(*")
(wcmatch (strcase line) "*IFCIUNIT(*"))
(wcmatch (strcase line) "*,.LENGTHUNIT.,*"))
(setq unitline line))
((not epsg)
(setq epsg (ifc-extract-epsg line)))
)
)
(close file)
(setq unit ".METRE.")
(setq prefix nil)
(if unitline
(progn
(setq params (ifc-split-params (ifc-extract-params unitline)))
(setq prefix (nth 2 params))
(setq unit (nth 3 params))
(cond
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".MILLI."))
(setq unit ".MILLIMETRE."))
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".CENTI."))
(setq unit ".CENTIMETRE."))
((and (= (strcase unit) ".METRE.")
(= (strcase prefix) ".KILO."))
(setq unit ".KILOMETRE."))
)
)
)
(setq scale (/ 1.0 (dwg-units->meters (getvar "INSUNITS"))))
(setq params (ifc-split-params (ifc-extract-params mapline)))
(setq x (* scale (atof (nth 2 params))))
(setq y (* scale (atof (nth 3 params))))
(setq z (* scale (atof (nth 4 params))))
(setq cosv (atof (nth 5 params)))
(setq sinv (atof (nth 6 params)))
(setq ang (atan sinv cosv)) ;; radians
(setq rot (* -180.0 (/ ang pi))) ;; degrees
(setq len (* scale 100.0))
;; Arrow
(drawarrow x y z (+ ang (/ pi 2)) len)
;; Text label
(setq txt (strcat (vl-filename-base path) ".ifc"))
(setq height (/ len 40.0))
(setq angTextDeg (* ang (/ 180.0 pi))) ;; same angle as arrow, in degrees
(command "_.TEXT" "_J" "TL" (list x y z) height angTextDeg txt)
(prompt
(strcat
"\nx=" (vl-princ-to-string x)
"\ny=" (vl-princ-to-string y)
)
)
;; Circles
(setq radius (* scale 25.0))
(setq radius1 (* scale 660.0))
(command "_.CIRCLE" (list x y z) (rtos radius 2 6))
(set-random-color-hash)
(command "_.CIRCLE" (list x y z) (rtos radius1 2 6))
(set-random-color-hash)
;; ------------------------------------------------------------
;; Create UCS based on IFC rotation and name it after the file
;; ------------------------------------------------------------
(setq ifcName (vl-filename-base path))
(setq ucsName (strcat "UCS_" ifcName))
;; If UCS already exists ³ delete it first
(if (tblsearch "UCS" ucsName)
(command "_.UCS" "DELETE" ucsName)
)
;; ang = IFC angle (radians)
(setq angArrow (+ ang (/ pi 2))) ;; arrow (upward)
(setq angUCS (- angArrow (/ pi 2))) ;; 90° CW from arrow
(setq angUCSdeg (* angUCS (/ 180.0 pi))) ;; degrees
(command "_.UCS" "_W")
(command "_.UCS" "_O" (list x y z))
(command "_.UCS" "_Z" angUCSdeg)
(command "_.UCS" "_S" ucsName)
(command "_.PLAN" "")
(command "_.UCS" "_W")
(if (wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
(command "_.ZOOM" "_EN" (entlast) "")
(command "_.ZOOM" "_O" (entlast) "")
)
(if (and
(wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
(wcmatch (getvar "ACADVER") "26.*")
)
(progn
(setq pt (strcat (rtos x 2 6) "," (rtos y 2 6) "," (rtos z 2 6)))
(setq ang (rtos rot 2 8))
(command "_.SETSURVEYLOCATION" "POINT" pt "angle" ang "")
(command "_.SETSURVEYLOCATION" "CLEAR")
(command "_.SETPROJECTLOCATION" "POINT" pt "angle" ang "")
(command "_.SETSITELOCATION" "POINT" pt "angle" ang "")
(if epsg
(progn
(setq cs (vl-string-subst "" "'" epsg))
(vl-cmdf "-GEOGRAPHICLOCATION" cs)
)
)
)
)
(setq platform-msg
(if (wcmatch (strcase (getvar "ACADVER")) "*BRICSCAD*")
"PROJECTLOCATION and SITELOCATION set"
"North direction drawn"
)
)
(alert
(strcat
"IFC4 MapConversion\n"
"\nXYZ (scaled): " (rtos x 2 3) ", " (rtos y 2 3) ", " (rtos z 2 3)
"\nRotation: " (rtos rot 2 8) " (" (rot-direction rot) ")"
"\nUnits: " unit
"\nDWG units: " (dwg-units->text (getvar "INSUNITS"))
"\nScale factor: " (rtos scale 2 6)
"\nEPSG: " (if epsg epsg "Not found")
"\n\n" platform-msg
)
)
)
