LISP INSERIR BLOCOS SOBRE TEXTO COM NUMEROS

[Anonymous]

Amigos, sei que a internet tem de tudo, mas não achei nada que me ajudasse, por isso estou recorrendo aos universitários.
Trabalho com Mapas no AUTOCAD. Neles existem vários textos com números de moradores. Preciso inserir manualmente um bloco sobre os textos com número maior que 11 moradores e digitar um texto no atributo desse bloco. Estou há dias tentando criar uma LISP onde seleciono todos os TEXTOS e o CAD, automaticamente, insere o bloco nos textos que contenham números acima de 11 e defina o atributo do bloco com o valor de 30% do número do texto. Sou leigo em LISP, por isso recorro a vocês que são feras nessa programação. Se puderem me indicar links ou me ajudarem a criar essa LISP com o conhecimento que possuem, me ajudariam muito, pois trabalho com mapas de cidades inteiras. Obrigado pela atenção!

[Anonymous]

Friends, I know the internet has everything, but I didn't find anything to help me, so I'm turning to college students. Working with Maps in AUTOCAD. In them there are several texts with numbers of residents. I need to manually insert a block over texts with more than 11 residents and type a text in the attribute of that block. I've been trying for days to create a LISP where I select all TEXTS and CAD automatically inserts the block in texts containing numbers above 11 and set the block attribute to 30% of the text number. I am a layman in LISP, so I turn to you who are beasts in this programming. If you can give me links or help me create this LISP with the knowledge you have, they would help me a lot because I work with maps of entire cities. Thanks for listening! (by google translate)

[Anonymous]

[Sea-Haven]

post sample dwg before after example.

[Anonymous]

Exemplo DWG / Sample DWG. 

Please HEEEELPPP!!!

[dlanorh · Accepted solution]

Lets hope your not working on a MAC

Try this. NOT tested as I don't have a full version of AutoCAD on the current laptop. Number x 0.3 is displayed to 1 decimal place using "," as decimal divider

(defun dxf (key lst) (cdr (assoc key lst)))

(defun rh:put_att_val (atts att val) (vl-some '(lambda (x) (if (= (strcase att) (strcase (vla-get-tagstring x))) (vla-put-textstring x val))) atts))

(vl-load-com)

(defun c:test ( / *error* c_doc c_spc sv_lst sv_vals ss obj ent t_str i_pt n_obj atts)

  (defun *error* ( msg )
    (vla-regen c_doc acallviewports)
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        blk "DEMANDA"                   ;BLOCK NAME
        sc 500.0                        ;BLOCK SCALE
  );end_setq

  (mapcar 'setvar sv_lst (list 0 0))

  (setq ss (ssget '((0 . "TEXT") (8 . "Domicilios"))))
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  t_no (atof (dxf 1 (entget ent)))
                  i_pt (if (= (vlax-get-property obj 'alignment) 0) (dxf 10 (entget ent)) (dxf 11 (entget ent)))
            );end_setq
            (cond ( (> 11.0 t_no)
                    (setq t_str (vl-string-translate "." "," (rtos (* t_no 0.3) 2 1))
                          n_obj (vlax-invoke c_spc 'insertblock i_pt blk sc sc sc 0.0)
                          atts (vlax-invoke n_obj 'getattributes)
                    );end_setq
                    (rh:put_att_val atts "DEMANDA" t_str); "DEMANDA" is also Attribute TAG name
                  )
            );end_cond
          );end_repeat
          (vla-regen c_doc acallviewports)
        )
        (t (alert "Nothing Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

[Anonymous]

Thank you! I will test and return! 😀

[dlanorh · Accepted solution]

I think I've got a bit wrong

(cond ( (> 11.0  t_no)

should be 

(cond ( (> t_no 11.0)

[Anonymous]

IT'S RETURN THE ERROR:
Oops an Error: no function definition: DXF occurred.

[Anonymous]

MISSED TO CHANGE THE CORRECTION THAT SENT AFTER. It worked! THANK YOU VERY MUCH!

[xuantientutungXUK6E]

i try and it work well. 

[dlanorh · Accepted solution]

I have now tested on my full autocad and adjusted the lisp accordingly.

The block is now positioned centrally below the text, allowing for the different scaling of the block (mm) and the drawing (m)

You are no longer asked to select text as it will now automatically select all text on the set layer.

I have indicated with comments items that can be changed to allow for different drawing set-ups

;;
(defun rh:gbbc (obj / ll ur lst c_pt)
  (if (and obj (= (type obj) 'ENAME))  (setq obj (vlax-ename->vla-object obj)))
  (cond (obj
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq lst (mapcar 'vlax-safearray->list (list ll ur))
                c_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst))
          );end_setq
        )
  );end_cond
  c_pt
);end_defun

(defun dxf (key lst) (cdr (assoc key lst)))

(defun rh:put_att_val (atts att val) (vl-some '(lambda (x) (if (= (strcase att) (strcase (vla-get-tagstring x))) (vla-put-textstring x val))) atts))

(vl-load-com)

(defun c:test ( / *error* c_doc c_spc sv_lst sv_vals ss obj ent t_str i_pt n_obj atts) ;; your can change test to whatever you desire

  (defun *error* ( msg )
    (vla-regen c_doc acallviewports)
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : ( " msg " ) occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        blk "DEMANDA"                   ;BLOCK NAME
        sc 0.5                 	        ;BLOCK SCALE
  );end_setq

  (mapcar 'setvar sv_lst (list 0 0))

  (setq ss (ssget "_X" '((0 . "TEXT") (8 . "Domicilios")))) ;Change (8 . "Domicilios") to the text layer you require
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  t_no (atof (dxf 1 (entget ent)))
                  i_pt (mapcar '+ (rh:gbbc obj) '(0.0 -0.000033 0.0)) ;change the -0.000033 to the y axis offset you require
            );end_setq
            (cond ( (> t_no 11.0)
                    (setq t_str (vl-string-translate "." "," (rtos (* t_no 0.3) 2 1))
                          n_obj (vlax-invoke c_spc 'insertblock i_pt blk sc sc sc 0.0)
                          atts (vlax-invoke n_obj 'getattributes)
                    );end_setq
                    (rh:put_att_val atts "DEMANDA" t_str) ;change "DEMANDA" to the attribute tag your require
                  )
            );end_cond
          );end_repeat
          (vla-regen c_doc acallviewports)
        )
        (t (alert "Nothing Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun