Author Topic: What do I need to do to make this entmake work?  (Read 6854 times)

0 Members and 1 Guest are viewing this topic.

daron

  • Guest
What do I need to do to make this entmake work?
« on: December 11, 2003, 11:29:48 AM »
Code: [Select]
(entmake '((0 . "TEXT")
  (410 . "Model")
  (8 . "SHEAR-NOTES")
  (10 732.144 167.223 0.0)
  (40 . 4.5)
  (50 . 0.0)
  (41 . 1.0)
  (51 . 0.0)
  (7 . "NOTES01")
  (71 . 0)
  (72 . 4)
  (11 733.344 169.248 0.0)
  (1 . "2")
  (70 . 0)
  (73 . 0)
  (74 . 0)
 )
)

SMadsen

  • Guest
What do I need to do to make this entmake work?
« Reply #1 on: December 11, 2003, 11:48:08 AM »
Where do you get the code 70 and 74 from?

Try removing them.

Added: on a side note, layers are created automatically with ENTMAKE, but text styles have to be present. But then you knew that.

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #2 on: December 11, 2003, 11:53:17 AM »
I'm trying to convert a bunch of attdef's into text strings. The removal works though. Thanks a bunch.

hendie

  • Guest
What do I need to do to make this entmake work?
« Reply #3 on: December 11, 2003, 11:55:45 AM »
damn, too late
Code: [Select]
(entmake '((0 . "TEXT")
  (100 . "AcDbEntity")
 ;(410 . "Model")
  (8 . "text")
  (10 732.144 167.223 0.0)
  (40 . 5.0)
  (50 . 0.0)
  (41 . 1.0)
  (51 . 0.0)
  (7 . "standard")
  (71 . 0)
  (72 . 0)
  (11 0.0 0.0 0.0)
  (1 . "2")
 ;(70 . 0)
  (100 . "acdbtext")

 ;(73 . 0)
 ;(74 . 0)
 )
)

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #4 on: December 11, 2003, 12:56:32 PM »
Quote
For legacy reasons, entmake ignores DXF group code 100 data for the following entity types:

AcDbText

Thanks Hendie, but dxf code 100 shouldn't work because of that^.

Next question. The previous question was for my own understanding of how to use entmake. What I want to do now is figure out how to get lisp to take info from an attdef entlist that would apply to a text entlist and create it for a list collection of entlists. Here's what I have come up with:
First, using Mark's recursive function, with a minor mod.
Code: [Select]
(defun ss->ent-list (ss lst)
     (cond ((ssname ss 0)
   (setq lst (vl-list*
  (entget (ssname ss 0))
  lst
     )
   )
   (ss->ent-list (ssdel (ssname ss 0) ss) lst)
  ) ; 1st cond
  ((null (ssname ss 0)) lst) ; 2nd cond
     ) ; cond
)

So, then I collect the list with this:
Code: [Select]
(setq attcoll (ss->ent-list (ssget "x" '((0 . "ATTDEF"))) nil))
I am thinking that mapcar would do well here, but this:
Code: [Select]
(setq alist ‘(410 8 10 40 50 41 51 7 71 72 11 1 73))
(setq elist (list (cons 0 “TEXT”)) (mapcar ‘assoc alist attcoll))

^That gives me a list for each item in the attcoll list i.e. item 1 returns the 410 list, item 2 returns the 8 list. So on and so forth until it reaches the end of attcoll list. Question: What do I need to do to set up a list for each object in attcoll and return a list of  entity lists? Or, how can I remove the attribute info from each entity in attcoll and change the values of  0 to “TEXT” instead of “ATTDEF”?

Columbia

  • Guest
What do I need to do to make this entmake work?
« Reply #5 on: December 11, 2003, 01:43:07 PM »
I know this doesn't answer your question, but...

Well when I was digging around in my "old programs" bin I found this chunk of code.  It might not do "exactly" what you want, but you might be able to modify it just a hair.  Anyway what it does is explode a block with attributes, but it retains what the attributes had as text strings and builds text out of that.  And it does it all using Active-X instead of EntMake/EntMod.  So it really doesn't do anything for your questions, I gues...

I hope you enjoy.  Please forgive me if I butt in where I'm not wanted... :)

Code: [Select]

;;;***********************************************************************
;;; ATT2TXT.LSP
;;; solution to a common problem. how to explode blocks with
;;; attributes, and retain the attribute value as text.
;;;***********************************************************************

(vl-load-com)

;;;*********************************************************************
;;; some small utility functions for use with this program
;;;*********************************************************************

(defun UndoBegin ()
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)

(defun UndoEnd ()
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)

(defun DXF (code elist) (cdr (assoc code elist)))

(defun MakeObject (obj)
  (cond
    ( (= (type obj) 'VLA-OBJECT) obj)
    ( (= (type obj) 'ENAME) (vlax-ename->vla-object obj))
  )
)

(defun Explode (obj / temp)
  (setq temp (vla-explode obj))
  (vla-delete obj)
  temp
)

(defun VarArray->List (vaobj)
  (vlax-SafeArray->List
    (vlax-Variant-Value vaobj)
  )
)

;;;***************************************************************************
;;; the command call function...
;;;***************************************************************************

(defun C:ATT2TXT (/ ss i)
  (princ "\nSelect Blocks to Extract Text...")
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (setq i  0)
      (UndoBegin)
      (repeat (sslength ss)
        (A2T (ssname ss i))
        (setq i (1+ i))
      )
      (UndoEnd)
    )
  )
  (princ)
)

;;;***********************************************************************
;;; Meat of the program follows...
;;;***********************************************************************

(defun A2T (obj / attlist attobj txt txtpt just inspt height width rot genflag
                  layr ent idx objList style space tmp upsid bkwd ltyp colr
                  attlyr attcol
           )
  (if
    (and
      (= (DXF 0 (entget obj)) "INSERT")
      (setq obj (MakeObject obj))
    )
   (if (= (vla-get-hasattributes obj) :vlax-true)
    (progn
        (setq attlist (varArray->List (vla-GetAttributes obj))
              idx     0
              layr    (vla-get-layer obj)
              ltyp    (vla-get-linetype obj)
              colr    (vla-get-color obj)
        )
        (repeat (length attlist)
          (setq attobj (nth idx attlist)
                txt    (append txt     (list (vla-get-textstring attobj)))
                txtpt  (append txtpt   (list (vla-get-textalignmentpoint attobj)))
                inspt  (append inspt   (list (vla-get-insertionpoint attobj)))
                just   (append just    (list (vla-get-alignment attobj)))
                height (append height  (list (vla-get-height attobj)))
                width  (append width   (list (vla-get-scalefactor attobj)))
                rot    (append rot     (list (vla-get-rotation attobj)))
                style  (append style   (list (vla-get-stylename attobj)))
                upsid  (append upsid   (list (vla-get-upsidedown attobj)))
                bkwd   (append bkwd    (list (vla-get-backward attobj)))
                attlyr (append attlyr  (list (vla-get-layer attobj)))
                attcol (append attcol  (list (vla-get-color attobj)))
                idx    (1+ idx)
          )
        )
        (setq objList (varArray->List (Explode obj))
              idx     0
        )
        (repeat (length objList)
          (setq ent (DXF 0 (entget (vlax-vla-object->ename (nth idx objList)))))
          (if (= ent "ATTDEF")
            (vla-erase (nth idx objList))
         (if
              (= (vla-get-layer (nth idx objList)) "0")
           (progn
                (vla-put-layer (nth idx objList) layr)
                (vla-put-linetype (nth idx objList) ltyp)
                (vla-put-color (nth idx objList) colr)
              )
         )
          )
          (setq idx (1+ idx))
        )
        (setq space (if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) acModelspace)
               (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
               (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
             )
              idx   0
        )
        (repeat (length attlist)
          (setq tmp (vla-addText space (nth idx txt) (nth idx inspt) (nth idx height)))
          (vla-put-alignment tmp (nth idx just))
          (if
            (and
              (/= (nth idx just) acAlignmentLeft)
              (/= (nth idx just) acAlignmentFit)
              (/= (nth idx just) acAlignmentAligned)
            )
            (vla-move tmp (vla-get-TextAlignmentPoint tmp) (nth idx txtpt))
            (progn
              (vla-move tmp (vla-get-InsertionPoint tmp) (nth idx inspt))
              (vla-put-alignment tmp acAlignmentLeft)
            )
          )
          (vla-put-rotation tmp (nth idx rot))
          (vla-put-scalefactor tmp (nth idx width))
          (vla-put-stylename tmp (nth idx style))
          (if (/= (nth idx attlyr) "0") (vla-put-layer tmp (nth idx attlyr)) (vla-put-layer tmp layr))
          (if (/= (nth idx attlyr) "0") (vla-put-color tmp (nth idx attcol)) (vla-put-color tmp colr))
          (cond
            ( (and (= (nth idx upsid) :vlax-true) (= (nth idx bkwd) :vlax-false))
              (vla-put-textgenerationflag tmp acTextFlagUpsideDown)
            )
            ( (and (= (nth idx upsid) :vlax-false) (= (nth idx bkwd) :vlax-true))
              (vla-put-textgenerationflag tmp acTextFlagBackward)
            )
            ( (and (= (nth idx upsid) :vlax-true) (= (nth idx bkwd) :vlax-true))
              (vla-put-textgenerationflag tmp (+ acTextFlagBackward acTextFlagUpsideDown))
            )
          )
          (setq idx (1+ idx))
        )
        (princ "\nAttributes Extracted.")
      )
      (princ "\nObject does not have attributes to extract.")
 )
    (princ "\nEntity is Not a Block Object!")
  )
  (UndoEnd)
  (princ)
)

;;***********************************************************************
(princ)

SMadsen

  • Guest
What do I need to do to make this entmake work?
« Reply #6 on: December 11, 2003, 02:10:48 PM »
Nice code, Columbia.

Daron, why don't you just remove the unwanted group codes instead of building them? Here's a draft that removes them, add a (0 . "TEXT"), swaps the tag to the text string (you might not want to do that?) and ENTMAKE'em

Code: [Select]
(defun attdef->text (/ sset slst elst dellst)
  (defun ent-p (i)(= (type i) 'ENAME))
  ;; remove the SSGET if you get a sset from somewhere else
  (cond ((setq sset (ssget "X" '((0 . "ATTDEF"))))
         (setq slst (ss->ent-list sset elst))
         (mapcar 'entmake
                (mapcar
                  (function (lambda (n)
                              ;; remove this if you don't want to delete the attdefs
                              (setq dellst (cons (cdr (assoc -1 n)) dellst))
                              ;; remove this if you don't want the tags to be the text
                              (setq n (subst (cons 1 (cdr (assoc 2 n)))(assoc 1 n) n))
                              ;; keep this regardless of the above
                              (append (list '(0 . "TEXT"))
                                      (foreach i '(0 2 3 70 74 100)
                                        (setq n (vl-remove (assoc i n) (reverse n)))))))
                  slst
                )
         )
         ;; remove this if you don't want to delete the attdefs
         (if (apply 'and (mapcar 'ent-p dellst))(mapcar 'entdel dellst))
        )
  )
  (princ)
)

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #7 on: December 11, 2003, 02:16:55 PM »
I'll see what I can do. Thanks C. Stig, that was an after thought as stated in my previous post and thank you for spelling it out for me.

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #8 on: December 11, 2003, 02:22:23 PM »
Stig, that was amazing and precisely what I need.

SMadsen

  • Guest
What do I need to do to make this entmake work?
« Reply #9 on: December 11, 2003, 02:46:03 PM »
Of course, you'll have to revise it after each revision of the DXF structure  :)

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #10 on: December 11, 2003, 02:48:09 PM »
What do you mean? Why?

SMadsen

  • Guest
What do I need to do to make this entmake work?
« Reply #11 on: December 11, 2003, 03:12:57 PM »
Last time it was revised, they added codes for true colors. That one applies to all drawing ents (I think?) but if ATTDEF's get new codes that TEXT's don't have then it'll have to be revised. In other words, I'm just blabbing.

While you're at it, here's a little routine that will remove an insert with attributes but convert all attributes to text - using the code removal stuff like above. Kinda like exploding a block, erasing all line art and keeping the attribute values.

And oh, you might want to rename it :D

Code: [Select]
(defun ReplaceAttributesWithTextAndEraseBlock (blk / ent entl attlst)
  (defun getDXF (lst elst / ll)
    (reverse (foreach n lst
               (setq ll (cons (cdr (assoc n elst)) ll))))
  )
  (setq ent blk entl (entget blk))
  (cond
    ((apply 'and (mapcar '= (getDXF '(0 66) entl) '("INSERT" 1)))
     (setq ent  blk entl (entget ent))
     (while (/= (cdr (assoc 0 entl)) "SEQEND")
       (and (= (cdr (assoc 0 entl)) "ATTRIB")
            (setq attlst (cons entl attlst)))
       (setq ent  (entnext ent) entl (entget ent)))
     (cond (attlst
        ;; remove this if insert shall not be erased
        (vl-cmdf "_.ERASE" blk "")
        (mapcar 'entmake
                (mapcar (function (lambda (n)
                              (append (list '(0 . "TEXT"))
                                      (foreach i '(0 2 3 70 74 100)
                                        (setq n (vl-remove (assoc i n) (reverse n))))
                              ))) attlst))))))
  (princ)
)

SMadsen

  • Guest
What do I need to do to make this entmake work?
« Reply #12 on: December 11, 2003, 03:26:29 PM »
Whoops, better not create invisible attributes .. I mean text entities! Here's a version that replaces empty text with "N/A"

Code: [Select]
(defun ReplaceAttributesWithTextAndEraseBlock (blk / ent entl attlst)
  (defun getDXF (lst elst / ll)
    (reverse (foreach n lst
               (setq ll (cons (cdr (assoc n elst)) ll))))
  )
  (setq ent blk entl (entget blk))
  (cond
    ((apply 'and (mapcar '= (getDXF '(0 66) entl) '("INSERT" 1)))
     (setq ent  blk entl (entget ent))
     (while (/= (cdr (assoc 0 entl)) "SEQEND")
       (and (= (cdr (assoc 0 entl)) "ATTRIB")
            (setq attlst (cons entl attlst)))
       (setq ent  (entnext ent) entl (entget ent)))
     (cond (attlst
        ;; remove this if insert shall not be erased
        (vl-cmdf "_.ERASE" blk "")
        (mapcar 'entmake
                (mapcar (function (lambda (n / txt)
                              (setq n   (append (list '(0 . "TEXT"))
                                          (foreach i '(0 2 3 70 74 100)
                                            (setq n (vl-remove (assoc i n) (reverse n)))))
                                    txt (cdr (assoc 1 n)))
                              (if (or (null txt)(= txt ""))(subst (cons 1 "N/A")(assoc 1 n) n) n)))
                        attlst))))))
  (princ)
)

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16867
  • Superior Stupidity at its best
What do I need to do to make this entmake work?
« Reply #13 on: December 11, 2003, 08:08:17 PM »
Yeah, those invisible text items can cause zooming problems.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9673
What do I need to do to make this entmake work?
« Reply #14 on: December 11, 2003, 09:19:53 PM »
Nice procedure name there Stig. :? I should really help you work on being a litte more specific in your procedure definition names.  :lol: :p
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

daron

  • Guest
What do I need to do to make this entmake work?
« Reply #15 on: December 11, 2003, 11:41:15 PM »
Thanks for the plethora, Stig.