Customize MText with multiple object data values and several conditions

[S.Röder]

Hi there,

I have loaded a GML file (NAS format or German ALKIS data) into AutoCAD Map 3D via MAPIMPORT with attached object data for the GIS attributes. For the correct display of the imported texts, I had already received good answers in the forum regarding the rotation and shifting of the texts. Here are the related links:

Rotate MText with individual Object Data Value

Shift MText by changing base point with individual Object Data Value

Both solutions iterate over all MTexts and apply the appropriate command. Currently I run both commands one after the other.

An additional special feature of the ALKIS data is that several model types can be defined in the GML file. Accordingly, a data set can contain different models, some of which contain overlapping information (e.g. for optimized representation in different scales). With my current import scheme, all imported text objects (Mtext) are marked with the OD attribute "modellart". The model type "DKKM1000" is relevant. Texts of the model type "DKKM2000", which can be deleted, are also imported but not required. I have also taken this special feature into account via a separate function.

Furthermore, all texts are imported on the layer "AP_PTO". Using the OD attribute "art", the texts should be differentiated accordingly and divided into separate layers.

My goal:

In order not to iterate over all texts for each command, I am now trying to write a LISP routine that takes into account all special features when importing display texts of the ALKIS schema and at the same time has an acceptable waiting time for processing the commands. Ideally, all texts should only be iterated once and the special features should be taken into account using appropriate conditions.

Here is the list of requirements again:

• Remove all texts with OD attribute "modellart=DKKM2000"
• Rotate texts with OD attribute "drehwinkel" accordingly
• Shift the base points of the texts according to the OD attributes "vertikaleAusrichtung" and "horizontaleAusrichtung", or move the texts accordingly
• Differentiate texts according to the OD attribute "art" and split them into separate layers

Here is my LISP:

(defun c:ALKIS_TextEdit( / l ss i e h v j rot art ent)		
  ;; convert units to radians for correct rotation angle of texts 
  (setvar "AUNITS" 3)
	
  ;; list for base points
  (setq l '(
      (("OBEN" "LINKSBÜNDIG") . 1)
      (("OBEN" "ZENTRISCH") . 2)
      (("OBEN" "RECHTSBÜNDIG") . 3)
      (("MITTE" "LINKSBÜNDIG") . 4)
      (("MITTE" "ZENTRISCH") . 5)
      (("MITTE" "RECHTSBÜNDIG") . 6)
      (("BASIS" "LINKSBÜNDIG") . 7)
      (("BASIS" "ZENTRISCH") . 8)
      (("BASIS" "RECHTSBÜNDIG") . 9)
    )
  )
	
  ;; helper function for attached Object Data 
  (defun GetFLD (TABLE FIELD EN / RecNO FldVAL)
    (setq RecNO	(ade_odgetrecord EN TABLE 0)
      FldVAL (ade_odgetrecfield RecNO FIELD)
    )
  )

  ;; iterate over all texts 
  (if (setq ss (ssget "_X" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e	 (ssname ss (setq i (1- i)))
        ent (entget e)
      )
    (progn	
      ;; remove texts with modelart DKKM2000 
      (if ( = (setq art (GetFLD "AP_PTO" "modellart" e)) "DKKM2000")
        (entdel e)
      )
				
      ;; adjust base points of texts 
      (if (and (setq h (GetFLD "AP_PTO" "horizontaleAusrichtung" e))
      (setq v (GetFLD "AP_PTO" "vertikaleAusrichtung" e)))
        (progn					
          (setq j (cdr (assoc (list (strcase v) (strcase h)) l)))
          (entmod (subst (cons 71 j) (assoc 71 ent) ent))
        )
      )

      ;; apply default rotation angle if greater than 0 
      (if ( > (setq rot (GetFLD "AP_PTO" "drehwinkel" e)) 0)
        (entmod (subst (cons 50 rot) (assoc 50 ent) ent))
      )
				
      ;; differentiate all texts by type on different layers 
      (if (setq art (GetFLD "AP_PTO" "art" e))
        (entmod (subst (cons 8 art) (assoc 8 ent) ent))
      )
    )
  )
)
	(princ)
)

Unfortunately, at the moment not all rules are observed and I can't understand why. For example, all texts with the OD attribute "modellart=DKKM2000" are deleted correctly, but the other texts are not rotated and moved.

Can someone help me? Suggested solutions are welcome.

Attached is a screenshot to clarify what I want to do. Also a test file in 2013 DWG file format.

Thanks in advance.

[ВeekeeCZ · Accepted solution]

1) if you remove some entities, exclude them from the further process.

(if true for remove

remove 

(progn .... all other conditions))

2) if you change some properties of ent, save it for further process.

(if.... 

(setq ent (entmod (subst (cons 50 rot) (assoc 50 ent) ent))))

[ВeekeeCZ]

---

@S.Röder wrote:

...

My goal:

In order not to iterate over all texts for each command, I am now trying to write a LISP routine that takes into account all special features when importing display texts of the ALKIS schema and at the same time has an acceptable waiting time for processing the commands. Ideally, all texts should only be iterated once and the special features should be taken into account using appropriate conditions.

...

---

This is a slightly more effective version. It updates the entity only once even if more than one property has been changed.

(defun c:ALKIS_TextEdit( / l ss i e h v j rot art ent old)
  ;; convert units to radians for correct rotation angle of texts
  ;(setvar "AUNITS" 3) - not needed. What's more important, be under WCS!!
  
  ;; list for base points
  (setq l '(
	    (("OBEN" "LINKSBÜNDIG") . 1)
	    (("OBEN" "ZENTRISCH") . 2)
	    (("OBEN" "RECHTSBÜNDIG") . 3)
	    (("MITTE" "LINKSBÜNDIG") . 4)
	    (("MITTE" "ZENTRISCH") . 5)
	    (("MITTE" "RECHTSBÜNDIG") . 6)
	    (("BASIS" "LINKSBÜNDIG") . 7)
	    (("BASIS" "ZENTRISCH") . 8)
	    (("BASIS" "RECHTSBÜNDIG") . 9)
	    )
	)
  
  ;; helper function for attached Object Data
  (defun GetFLD (TABLE FIELD EN / RecNO FldVAL)
    (setq RecNO	(ade_odgetrecord EN TABLE 0)
	  FldVAL (ade_odgetrecfield RecNO FIELD)))
  
  ;; iterate over all texts
  (if (setq ss (ssget "_X" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
	    ent (entget e)
	    old ent)
      
      ;; remove texts with modelart DKKM2000
      (if ( = (setq art (GetFLD "AP_PTO" "modellart" e)) "DKKM2000")
	(entdel e)
	
	;; else seek for changes:
	
	(progn
	  
	  ;; adjust base points of texts
	  (and (setq h (GetFLD "AP_PTO" "horizontaleAusrichtung" e))
	       (setq v (GetFLD "AP_PTO" "vertikaleAusrichtung" e))
	       (setq j (cdr (assoc (list (strcase v) (strcase h)) l)))
	       (setq ent (subst (cons 71 j) (assoc 71 ent) ent))
	       )
	  
	  ;; apply default rotation angle if greater than 0
	  (and  (> (setq rot (GetFLD "AP_PTO" "drehwinkel" e)) 0)
		(setq ent (subst (cons 50 rot) (assoc 50 ent) ent))
		)
	  
	  ;; differentiate all texts by type on different layers
	  (and (setq art (GetFLD "AP_PTO" "art" e))
	       (setq ent (subst (cons 8 art) (assoc 8 ent) ent)))
	  
	  
	  ;; update ent if any change has been made
	  (if (not (equal old ent))
	    (entmod ent))
	  
	  ))))
  
  (princ)
  )

[S.Röder]

Thanks man! The first tip was already successful, but now it's even faster. Perfect!

If you have any other tips for more effective or faster processing, please let me know. I appreciate that.