Object Data String Update From Text

[shil143]

Hi,

I need a lisp to Update Polygon Object data "SUN_NO" Data Auto Update from polygon Overlapping text.

 Refer Attached Image. i need a lisp to do this work

[hak_vz]

Attach sample DWG.

[shil143]

Sample Drawing...

[pbejse]

---

@shil143 wrote:

I need a lisp to Update Polygon Object data "SUN_NO" Data Auto Update from polygon Overlapping text.

---

Look into Object Data Functions 

The data is not exposed to Vanilla cad, i can not even run a test. perhaps anyone with Civil 3D or Autoacd MAP 3D can have a look

[hak_vz]

I don't use Civil 3d.

See @pbejse post about Object data functions. Here is my code that links text data to appropriate Mpolygon object

You just have to add appropriate function instead princ statement that prints text values to console.

(princ (strcat "\n" tv))

(defun c:SETMPDATA nil (SETMPDATA))
(defun SETMPDATA (ss j pts tv);

(defun getmpolypoints (e / ent p0 i pp ret pts)
	(setq ent (entget e) p0 (cdr (assoc 11 ent)) i 0)
	(repeat (length ent) (setq pp (nth i ent))(if (eq (car pp) 10) (setq ret (append ret (list (cdr pp))))) (setq i (+ i 1)))
	(foreach pt ret (setq pts (cons (mapcar '+ p0 pt) pts)))
	(cdr (reverse pts))
)

(setq ss (ssget "_x" '((0 . "MPOLYGON"))) j 0)

(repeat (sslength ss)
(setq pts (getmpolypoints(ssname ss j)))
(setq tv (cdr (assoc 1 (entget (ssname(ssget "_CP" pts '((0 . "*TEXT"))) 0)))))

;--------------------------
(princ (strcat "\n" tv))
;-----------------------

(setq j (+ j 1))
)

(princ)
)

[shil143]

when i read in civil 3D =.. Showing error

; error: too few arguments

[hak_vz]

At my side it works OK.  I'll check it later today, and try to write additional data to create data record. I need to look inside Autolisp reference for CIV 3d or MAP.

I hope you know some basic autolisp scripting and testing.

[CADaSchtroumpf · Accepted solution]

With your sample drawing, this can be to work's

(defun c:text2OD_mp ( / v e l lst ll p ent_po vla_obj ent1_off ent2_off lst1_pt lst2_pt lst_pt js kmod)
  ;; by ElpanovEvgeniy
  ;; convert MPolygon to Lwpolyline
  ;; version 0.2
  ;; 2012.07.11
  ;; mailto: elpanov@gmail.com
  ;; web:    elpanov.com
	(while (not (setq v (ssget "_+.:E:S" '((0 . "MPOLYGON"))))))
	(setq
		e (entget (cadar (ssnamex v)))
		v (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
		l
		(vl-remove nil
			(list
					'(0 . "LWPOLYLINE")
					'(100 . "AcDbEntity")
					(assoc 67 e)
					(assoc 410 e)
					(assoc 8 e)
					(if (assoc 63 e)
						(cons 62 (cdr (assoc 63 e)))
					)
					(if (assoc 421 e)
						(cons 420 (cdr (assoc 421 e)))
					)
					'(100 . "AcDbPolyline")
			)
		)
		lst e
		ll nil
	)
	(defun f (l i)
		(if (> i 0)
			(cons (mapcar (function +) (car l) v) (f (cdr l) (1- i)))
		)
	)
	(while (setq lst (member (assoc 93 (cdr lst)) (cdr lst)))
		(setq p (f (cdr lst) (cdar lst))
			ll (append ll (list '(92 . 7) '(72 . 0) '(73 . 1) (car lst)) p '((97 . 0)))
		)
		(entmakex (vl-remove nil (append l (list (cons 90 (cdar lst)) '(70 . 1)) p (list (assoc 210 e)))))
	)
	(setq vla_obj (vlax-ename->vla-object (setq ent_po (entlast))))
	(vla-Offset vla_obj 1.0)
	(setq ent1_off (entlast))
	(vla-Offset vla_obj -1.0)
	(setq ent2_off (entlast))
	(entdel ent_po)
	(setq
		lst1_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent1_off)))
		lst2_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent2_off)))
	)
	(if (> (distance (cdr (assoc 11 e)) (car lst1_pt)) (distance (cdr (assoc 11 e)) (car lst2_pt)))
		(setq lst_pt lst1_pt)
		(setq lst_pt lst2_pt)
	)
	(entdel ent1_off) (entdel ent2_off)
	(setq js (ssget "_WP" lst_pt '((0 . "TEXT") (8 . "Text"))))
	(sssetfirst nil js)
	(cond
		((and js (eq (sslength js) 1))
			(initget "Yes No")
			(setq kmod (getkword "\nProcess selection [Yes/No]? <Yes>: "))
			(if (or (eq kmod "Yes") (not kmod)) (setq kmod "Yes") (setq kmod "No")) 
			(cond
				((eq kmod "No")
					(princ "\nAbandon")
				)
				(T
					(ade_odsetfield (cdar e) "SUN" "SUN_NO" 0 (cdr (assoc 1 (entget (ssname js 0)))))
				)
			)
		)
	)
	(sssetfirst nil nil)
	(prin1)
)

[shil143]

"You just have to add appropriate function instead princ statement that prints text values to console"

What I Need to Add ...😊

[shil143]

Thanks BOSS.........

[hak_vz]

---

@shil143 wrote:

"You just have to add appropriate function instead princ statement that prints text values to console"

What I Need to Add ...😊

---

Something like

(ade_odsetfield (ssname ss j) "SUN" "SUN_NO" 0 tv))))

[shil143]

Still Same Error ...... ; error: too few arguments 

@hak_vz Thanks For Your Valuable Time...I Got Solution from @CADaSchtroumpf 

[hak_vz]

@shil143You have received your solution and that's what all is about.

I have worked with Mpolygon for a first time, managed to decipher how data are stored, recreated its boundary..., andhopped it will work. So no time is wasted. 🙂

[braudpat]

Hello @CADaSchtroumpf 

1) THANKS and as usual a Beautiful routine !

2) Please is it possible to have the same routine with standard 2D LWPolylines (NOT MPolygon !) and a Text inside ? 

Because a Lisp routine will be easier / faster to use than some "special" MAP Features !

THE HEALTH, Regards, Patrice

[hak_vz · Accepted solution]

@braudpat   Try this:

(defun c:SETMPDATA nil (SETMPDATA))
(defun SETMPDATA ( / ss j pts tv);

(defun getmpolypoints (e / ent p0 i pp pts)
	(setq ent (entget e) p0 (cdr (assoc 11 ent)) i 0)
	(repeat (length ent) (setq pp (nth i ent))(if (eq (car pp) 10) (setq pts (append pts (list (cdr pp))))) (setq i (+ i 1)))
	pts
)

(setq ss (ssget "_x" '((0 . "*polyline"))) j 0)
(setq fieldname (getstring "\nField name >"))
(repeat (sslength ss)
(setq pts (getmpolypoints(ssname ss j)))
(setq tv (cdr (assoc 1 (entget (ssname(ssget "_CP" pts '((0 . "*TEXT"))) 0)))))

;--------------------------
(ade_odsetfield (ssname ss j) "Desc" fieldname 0 tv)
;-----------------------

(setq j (+ j 1))
)

(princ)
)

Eventually check how  ade_odsetfield is defined. In my previous post I forgot / in function definition and it generated an error.

[braudpat]

Hello @hak_vz 

THANKS for your routine : it is very short !

I have changed the tittle and added very minor things ... 

THE HEALTH, Regards, Patrice

 
;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/object-data-string-update-from-text/td-p/9819766
;; 
;; Routine: Text2ODPol by hak_vz
;; 
;; Copy TEXT INSIDE closed PLine to an OD Field (MAP or CIVIL required) 
;; ATTENTION : NO Error Management !
;; 

;; (defun c:SETMPDATA  nil (SETMPDATA)) 
   (defun c:Text2ODPol nil (SETMPDATA)) 

(defun SETMPDATA ( / ss j pts tv) ;

(defun getmpolypoints (e / ent p0 i pp pts) 
	(setq ent (entget e) p0 (cdr (assoc 11 ent)) i 0)
	(repeat (length ent) (setq pp (nth i ent))(if (eq (car pp) 10) (setq pts (append pts (list (cdr pp))))) (setq i (+ i 1)))
	pts
)

;; (setq ss (ssget "_x" '((0 . "*polyline"))) j 0) 
   (setq ss (ssget      '((0 . "*polyline"))) j 0) 

;;;;;;  Warnings ;;;;;; 
(princ "\nPlease give the CORRECT Name for the OD Table AND the OD Field ! " ) 
(princ "\nALL 2D PLines selected must ALREADY have the right OD Table attached ! \n" ) 

(setq ODTableName (getstring "\nOD Table Name > ")) 
(setq ODFieldName (getstring "\nOD Field Name for the TEXT inside > ")) 

(repeat (sslength ss)
(setq pts (getmpolypoints(ssname ss j)))
(setq tv (cdr (assoc 1 (entget (ssname(ssget "_CP" pts '((0 . "*TEXT"))) 0)))))

;--------------------------
;; (ade_odsetfield (ssname ss j) "Desc"      ODFieldName 0 tv) 
   (ade_odsetfield (ssname ss j) ODTableName ODFieldName 0 tv) 
;-----------------------

(setq j (+ j 1))
)

(princ) 
) 

[shil143]

@braudpat @CADaSchtroumpf @hak_vz 

Interesting.............Can You Change to Multiple Object Selection....... 

[braudpat]

Hello @shil143 @hak_vz @CADaSchtroumpf 

1) First I have removed "MY"solution because I am almost "null" in Lisp/AutoLisp

The Lisp routine (related to Polylines) is 99.99% from @hak_vz !

2) I have tried to update the @CADaSchtroumpf routine (related to MPolygons)

but WITHOUT success !!

;; New Lines to get the 2 Names ... WHERE I have to insert these 2 Lines ???

;; It seems to be wrong just after the defun !!
(setq ODTableName (getstring "\nOD Table Name > "))
(setq ODFieldName (getstring "\nOD Field Name for the TEXT inside > "))

-- Original line from Mr CADaSchtroumpf :
(ade_odsetfield (cdar e) "SUN" "SUN_NO" 0 (cdr (assoc 1 (entget (ssname js 0)))))
-- Changed to :
(ade_odsetfield (cdar e) ODTableName ODFieldName 0 (cdr (assoc 1 (entget (ssname js 0)))))

3) What do you mean by >>> Can You Change to Multiple Object Selection <<<

Do you want a general purpose routine for MPolygons, 2D Closed PLines, Cercles ??

THANKS in advance for your help !

THE HEALTH, Regards, Patrice

[hak_vz]

@braudpat  I would help but have no access Civil 3d or MAP 3d.

From Googling results I've get that formulation is

(ade_odsetfield x table y 0 z)
where x is the entity name; table is the table name; y is the field name; 0 is the record number; z is the value for the field.

Consult this link for Autocad MAP 3D Autolisp reference