Message 1 of 3
Lisp to create Area with Field creating New Object or selecting Existing Object
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I'm tring to modify a lisp. Actually it needs a selection (1 object by picbox) with vlax-get-acad-object.
I want catch Automatically the entlast object if the chosen method is Rectang, or Pline, or Boundary
About the code, is to create a text with field associated to object area, using the area conversion based in the units of file (results always in m²)
Look in the code:
---------> If option is R i want make rectang
---------> if option is P i want make polyline
If I draw a object (Pline, Rectang or boundary) I want select automatically this object to continue with the routine below
(defun c:AREAFIELD (/ Get-ObjectIDx64 space ss pt) (unidadesporfavor) (setq actualunits (getvar "LUNITS")) (setq actualprec(getvar "LUPREC")) (setvar "LUNITS" 2) (setvar "LUPREC" 8) (converterparametrosquadradosporfavor) (setq scalestring (rtos fatormetroquadrado)) (setvar "LUNITS" actualunits)(setvar "LUPREC" actualprec) (if (= prefixarea nil)(setq prefixarea "A: ")) (if (= prefixopiso nil)(setq prefixopiso "P: ")) (if (= desecomp nil)(setq desecomp "Sim")) (if (= desepiso nil)(setq desepiso "Sim")) (if (= metodoarea nil)(setq metodoarea "Objeto")) (setq keyfrase(strcat "\nOpções[Objeto/Retangular /PoLyline/Boundary / Prefixo de área=" prefixarea " /PRefixo de piso=" prefixopiso "/Escrever piso=" desepiso "/EScrever compartimento=" desecomp "/ Unidades: "unidades"]<" metodoarea ">")) (initget "O R PL B X P PR E ES U" 0) (setq keyopt(getkword keyfrase)) (cond ( (= keyopt "P") (Setq prefixarea (getstring T "\Prefixo de área: ")) (c:AREAFIELD) ) ( (= keyopt "PR") (Setq prefixopiso (getstring T "\Prefixo de piso: ")) (c:AREAFIELD) ) ((= keyopt "U")(command "._DDUNITS" )(c:areafield)) ( (= keyopt "E") (if (= desepiso "Sim")(setq desepiso "Não")(setq desepiso "Sim")) (c:AREAFIELD) ) ( (= keyopt "ES") (if (= desecomp "Sim")(setq desecomp "Não")(setq desecomp "Sim")) (c:AREAFIELD) ) ) (if (= desecomp "Sim") (progn (initget "S SA C Q D SU B BA L LA CI H AL G V SAC ES SAL E" 128) (setq COMP(getstring T "\nCompartimento:[Sala / SAla de estar / Cozinha / Quarto / Dormitório / SUíte / Banho / BAnheiro / Lavabo / LAvanderia / CIrculação / Hall / ALpendre / Garagem / Varanda / SACada / EScritório / SALa de jantar / Estar íntimo / ]<...> ")) (cond ((= comp "S")(SETQ COMPARTIMENTO (strcat "Sala"))) ((= comp "SA")(SETQ COMPARTIMENTO (strcat "Sala de Estar"))) ((= comp "C")(SETQ COMPARTIMENTO (strcat "Cozinha"))) ((= comp "Q")(SETQ COMPARTIMENTO (strcat "Quarto"))) ((= comp "D")(SETQ COMPARTIMENTO (strcat "Dormitório"))) ((= comp "SU")(SETQ COMPARTIMENTO (strcat "Suíte"))) ((= comp "B")(SETQ COMPARTIMENTO (strcat "Banho"))) ((= comp "BA")(SETQ COMPARTIMENTO (strcat "Banheiro"))) ((= comp "L")(SETQ COMPARTIMENTO (strcat "Lavabo"))) ((= comp "LA")(SETQ COMPARTIMENTO (strcat "Lavanderia"))) ((= comp "CI")(SETQ COMPARTIMENTO (strcat "Circulação"))) ((= comp "H")(SETQ COMPARTIMENTO (strcat "Hall"))) ((= comp "A")(SETQ COMPARTIMENTO (strcat "Alpendre"))) ((= comp "G")(SETQ COMPARTIMENTO (strcat "Garagem"))) ((= comp "V")(SETQ COMPARTIMENTO (strcat "Varanda"))) ((= comp "SAC")(SETQ COMPARTIMENTO (strcat "Sacada"))) ((= comp "ES")(SETQ COMPARTIMENTO (strcat "Escritório"))) ((= comp "SAL")(SETQ COMPARTIMENTO (strcat "Sala de Jantar"))) ((= comp "E")(SETQ COMPARTIMENTO (strcat "Estar Íntimo"))) ((= (type COMP) 'STR)(setq compartimento comp)) ) ) ) (if (= desepiso "Sim") (progn (initget "N T PA TA LA C PO B BA PED CI CIM TI CO" 128) (setq TPISO(getstring T "\nPiso:[... / Tabuão / PArquê / TAcos / LAminado / Cerâmico / POrcelanato / Basalto regular / BAsalto irregular / PEDra portuguesa / CImento alisado / CIMento queimado / TIjolo / COncreto intertravado]<...>")) (cond ((= TPISO "T")(SETQ PISO (strcat "Tabuão"))) ((= TPISO "PA")(SETQ PISO (strcat "Parquê"))) ((= TPISO "TA")(SETQ PISO(strcat "Tacos"))) ((= TPISO "LA")(SETQ PISO(strcat "Piso Laminado"))) ((= TPISO "C")(SETQ PISO(strcat "Piso Cerâmico"))) ((= TPISO "PO")(SETQ PISO(strcat "Porcelanato"))) ((= TPISO "B")(SETQ PISO(strcat "Basalto Regular"))) ((= TPISO "BA")(SETQ PISO(strcat "Basalto Irregular"))) ((= TPISO "PED")(SETQ PISO(strcat "Pedra Portuguesa"))) ((= TPISO "CI")(SETQ PISO(strcat "Cimento Alisado"))) ((= TPISO "CIM")(SETQ PISO(strcat "Cimento Queimado"))) ((= TPISO "TI")(SETQ PISO(strcat "Tijolo"))) ((= TPISO "CO")(SETQ PISO(strcat "Concreto Intertravado"))) ((= (type TPISO) 'STR)(setq PISO TPISO)) ) ) ) (cond ( (= keyopt "R");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;---------> If option is R i want make rectang (command "._RECTANG" pause pause) ) ( (= keyopt "P");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;---------> if option is P i want make polyline (command "._pline") (while (wcmatch (getvar "cmdnames") "*PLINE*") (command pause) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; If I draw a object (Pline, Rectang or boundary) I want select automatically this object to continue with the routine below (defun Get-ObjectIDx64 (obj / util) (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object)))) (if (> (vl-string-search "x64" (getvar "platform")) 0) (vlax-invoke-method util "GetObjectIdString" obj :vlax-False) (itoa (vla-get-Objectid obj)) ) ) (setq space (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) (if (and (setq ss (car (entsel "\n Select Object for Area : "))) (setq pt (getpoint "\n Specify Text Location :")) (setq PT (trans pt 1 0)) ) (cond ( (and (= desecomp "Sim")(= desepiso "Sim")) (vla-addMText space (vlax-3d-point pt)1.(strcat COMPARTIMENTO "\\P" PREFIXAREA "%<\\AcObjProp Object(%<\\_ObjId "(Get-ObjectIDx64 (vlax-ename->vla-object ss))">%).Area \\f \"%lu2%pr2%ps[, m²]%ct8["scalestring"]\">%" "\\P" PREFIXOPISO PISO)) ) ( (= desecomp "Sim") (vla-addMText space (vlax-3d-point pt)1.(strcat COMPARTIMENTO "\\P" PREFIXAREA "%<\\AcObjProp Object(%<\\_ObjId "(Get-ObjectIDx64 (vlax-ename->vla-object ss))">%).Area \\f \"%lu2%pr2%ps[, m²]%ct8["scalestring"]\">%")) ) ( (= desepiso "Sim") (vla-addMText space (vlax-3d-point pt)1.(strcat "\\P" PREFIXAREA "%<\\AcObjProp Object(%<\\_ObjId "(Get-ObjectIDx64 (vlax-ename->vla-object ss))">%).Area \\f \"%lu2%pr2%ps[, m²]%ct8["scalestring"]\">%" "\\P" PREFIXOPISO PISO)) ) ( (vla-addMText space (vlax-3d-point pt)1.(strcat "\\P" PREFIXAREA "%<\\AcObjProp Object(%<\\_ObjId "(Get-ObjectIDx64 (vlax-ename->vla-object ss))">%).Area \\f \"%lu2%pr2%ps[, m²]%ct8["scalestring"]\">%")) ) ) ) (command "_.justifytext" (entlast) "" "mc") ) (defun unidadesporfavor() (setq unitscode (getvar "insunits")) (cond ((= unitscode 0)(setq unidades "não definida")) ((= unitscode 1)(setq unidades "polegadas")) ((= unitscode 2)(setq unidades "pés")) ((= unitscode 3)(setq unidades "milhas")) ((= unitscode 4)(setq unidades "milímetros")) ((= unitscode 5)(setq unidades "centímetros")) ((= unitscode 6)(setq unidades "metros")) ((= unitscode 7)(setq unidades "quilômetros")) ((= unitscode 8)(setq unidades "micropolegadas")) ((= unitscode 9)(setq unidades "mils")) ((= unitscode 10)(setq unidades "jardas")) ((= unitscode 11)(setq unidades "angstrom")) ((= unitscode 12)(setq unidades "nanômetros")) ((= unitscode 13)(setq unidades "micrômetro")) ((= unitscode 14)(setq unidades "decímetros")) ((= unitscode 15)(setq unidades "decâmetros")) ((= unitscode 16)(setq unidades "hectômetros")) ((= unitscode 17)(setq unidades "gigametros")) ((= unitscode 18)(setq unidades "unidades astronômicas")) ((= unitscode 19)(setq unidades "anos luz")) ((= unitscode 20)(setq unidades "parsecs")) ) ) (defun converterunidadesporfavor() (setq unitscode (getvar "insunits")) (cond ((= unitscode 0)(setq scalefactorunits 1.0)) ((= unitscode 1)(setq scalefactorunits 25.4)) ((= unitscode 2)(setq scalefactorunits 304.8)) ((= unitscode 3)(setq scalefactorunits 1609344)) ((= unitscode 4)(setq scalefactorunits 1.0)) ((= unitscode 5)(setq scalefactorunits 10.0)) ((= unitscode 6)(setq scalefactorunits 1000.0)) ((= unitscode 7)(setq scalefactorunits 1000000.0)) ((= unitscode 8)(setq scalefactorunits 0.0000254)) ((= unitscode 9)(setq scalefactorunits 0.0254)) ((= unitscode 10)(setq scalefactorunits 9144.0)) ((= unitscode 11)(setq scalefactorunits 0.0000001)) ((= unitscode 12)(setq scalefactorunits 0.000000001)) ((= unitscode 13)(setq scalefactorunits 0.001)) ((= unitscode 14)(setq scalefactorunits 100.0)) ((= unitscode 15)(setq scalefactorunits 10000.0)) ((= unitscode 16)(setq scalefactorunits 100000.0)) ((= unitscode 17)(setq scalefactorunits 1000000000)) ((= unitscode 18)(setq scalefactorunits 149597870700000)) ((= unitscode 19)(setq scalefactorunits 9460730472580800000)) ((= unitscode 20)(setq scalefactorunits 30856778200000000000)) ) ) (defun converterparametrosquadradosporfavor() (converterunidadesporfavor) (setq fatormetroquadrado (*(/ scalefactorunits 1000) (/ scalefactorunits 1000))) )
TIA
