Author Topic: ENTMAKE function  (Read 38585 times)

0 Members and 2 Guests are viewing this topic.

CADaver

  • Guest
ENTMAKE function
« Reply #15 on: April 18, 2005, 01:56:07 PM »
This is so cool, I've learned more in the last 10 minutes than I have in the last year.  

EGAD, I LOVE this place.

David Bethel

  • Swamp Rat
  • Posts: 641
ENTMAKE function
« Reply #16 on: April 18, 2005, 01:57:02 PM »
Here's a link to a routine I wrote years ago as public domain but still use it regularly.

http://www.davidbethel.com/lisp/exemk.lsp

Simply select the entities you wish to convert to entmake format.  Quote or list, minimum data or full.  Writes them to an ASCII file with the extension .EMK

Use the (load "name.EMK") function to call them back in

I have 5 or 6 variations of it that can make each axis have a base point so that it can be edited later into a parametric routine.  -David

MP:  I lurk here fairly regular, Just not many threads are applicable to R12 anymore.
R12 Dos - A2K

MP

  • Seagull
  • Posts: 17446
ENTMAKE function
« Reply #17 on: April 18, 2005, 02:00:04 PM »
Quote from: CADaver
This is so cool, I've learned more in the last 10 minutes than I have in the last year.

I have a feeling you're about to learn far more than you bargained for in very short order, and I don't mean lisp.

\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CADaver

  • Guest
ENTMAKE function
« Reply #18 on: April 18, 2005, 02:07:21 PM »
Quote from: MP
I have a feeling you're about to learn far more than you bargained for in very short order, and I don't mean lisp.

eh??

... omigosh DENT?  
anyone seen Dent?

MP

  • Seagull
  • Posts: 17446
ENTMAKE function
« Reply #19 on: April 18, 2005, 02:09:07 PM »
Quote from: CADaver
eh??

Randy speaks Canuckian, who knew?

10 9 8 ...
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CADaver

  • Guest
ENTMAKE function
« Reply #20 on: April 18, 2005, 02:11:11 PM »
Quote from: MP
Quote from: CADaver
eh??

Randy speaks Canuckian, who knew?
spent 6 months in Calgary

Quote from: MP
10 9 8 ...
 Where'd I put that chain-mail underwear???

MP

  • Seagull
  • Posts: 17446
ENTMAKE function
« Reply #21 on: April 18, 2005, 02:15:49 PM »
I spent a couple hours in Texas when I was 5 years old (as we travelled by car from San Diego California to South Carolina).

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CADaver

  • Guest
ENTMAKE function
« Reply #22 on: April 18, 2005, 02:22:39 PM »
Quote from: MP
I spent a couple hours in Texas when I was 5 years old (as we travelled by car from San Diego California to South Carolina).

:)
Couple hours??? musta crossed the Panhandle.

ronjonp

  • Needs a day job
  • Posts: 7027
ENTMAKE function
« Reply #23 on: April 18, 2005, 07:17:19 PM »
Cab,

What am I doing wrong with this lisp? I could only create the entities in red:

I loaded the lisp...selected objects...then dragged the created lsp file into a blank drawing.

■3DFACE
■3DSOLID
■ACAD_PROXY_ENTITY
■ARC
■ATTDEF
■ATTRIB
■BODY
■CIRCLE
■DIMENSION
■ELLIPSE
■HATCH
■IMAGE
■INSERT
■LEADER
■LINE
■LWPOLYLINE
■MLINE
■MTEXT
■OLEFRAME
■OLE2FRAME
■POINT
■POLYLINE
■RAY
■REGION
■SEQEND
■SHAPE
■SOLID
■SPLINE
■TEXT
■TOLERANCE
■TRACE
■VERTEX
■VIEWPORT
■XLINE

Thanks,

Ron

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
ENTMAKE function
« Reply #24 on: April 18, 2005, 11:28:26 PM »
Ron,
Try this,  and give me an update on what is not working.
It appears that some entities require the dxf 100 to remain in the list.
I also added 340 to the strip list.
I will post another version as soon as I get MP's code working with the routine.
There is a bug where the strings are getting stripped of the quotes, but I haven't
figured out why. His subroutine is needed to get the precision for point list.
This is a must have subroutine. So I'll work on it as soon as I can get back to it
unless MP has the answer. That will fix some of the entities, but dimensions are
not working and I don't know why yet. I am out of free time for the next day or so.
I'll be back.

Code: [Select]
;; here's a thing that can make entmakes of almost anything pulled from a drawing:
;; correction by CAB 11/19/04 - did not remove douplicate codes
;; CAB added removal of 340 410 210


(defun C:makeEntmake (/ a dwg path ent entl fn sset)
  (setq path (getvar "DWGPREFIX")
        dwg  (strcat path (vl-filename-base (getvar "DWGNAME")) ".lsp")
        fn   (open dwg "w")
        a    0
  )
  (cond
    (fn
     (cond ((setq sset (ssget))
            (repeat (sslength sset)
              (setq ent  (ssname sset a)
                    entl (entget ent)
              )
  (foreach n '(-2 -1 5 102 300 330 331 340 350 360 410 210);410 210 340
    (while (assoc n entl)
      (setq entl (vl-remove (assoc n entl) entl))
    )
  )
              (write-line (strcat "(entmake '" (vl-prin1-to-string entl) ")") fn)
              (setq a (1+ a))
            )
           )
     )
     (close fn)
    )
  )
  (princ)
)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

MP

  • Seagull
  • Posts: 17446
ENTMAKE function
« Reply #25 on: April 18, 2005, 11:35:39 PM »
Does this help Charles --

Code: [Select]
(defun ToString ( x / typex )

    ;;  convert item to a string, if x is a real use
    ;;  the highest possible precision, if x is a
    ;;  string double quote it, if x is a list process
    ;;  each item in the list appropriatel, otherwise
    ;;  just hammer item with vl-princ-to-string

    (cond

        ;;  it's a string, return it double quoted

        (   (eq 'str (setq typex (type x)))

            (strcat "\"" x "\"")

        )

        ;;  it's a real, covert to the highest possible
        ;;  resolution string equivalent

        (   (eq 'real typex)
       
            (rtos x 2 (if (zerop (- x (fix x))) 1 15))

        )

        ;;  it's a list

        (   (eq 'list typex)

            (if (vl-list-length x)

                ;;  it's a normal list

                (strcat
                    (chr 40)
                    (ToString (car x))
                    (apply 'strcat
                        (mapcar
                           '(lambda (x)
                                (strcat " " (ToString x))
                            )
                            (cdr x)
                        )
                    )
                    (chr 41)
                )

                ;;  it's a dotted pair

                (strcat
                    (chr 40)
                    (ToString (car x))
                    " . "
                    (ToString (cdr x))
                    (chr 41)
                )

            )

        )

        ;;  hammer down on everything else

        ((vl-princ-to-string x))
    )
)


:cheesy:
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
ENTMAKE function
« Reply #26 on: April 18, 2005, 11:52:36 PM »
Aaaaah, That did it, Thanks MP :)
We still need Ron to test all the objects.
Code: [Select]

Old Code Removed, See later post...
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7027
ENTMAKE function
« Reply #27 on: April 19, 2005, 09:46:39 AM »
Here is what I got with that latest routine:



Dimension=nil

Code: [Select]
(entmake '((0 . "DIMENSION") (100 . "AcDbEntity") (67 . 0) (8 . "dimension") (100 . "AcDbDimension") (2 . "*D2") (10 46.50071028899857 15.89031347578914 0.000000000000000) (11 43.40539044772859 15.44197223547151 0.000000000000000) (12 0.000000000000000 0.000000000000000 0.000000000000000) (70 . 33) (1 . "") (71 . 5) (72 . 1) (41 . 1.000000000000000) (42 . 6.255242533276899) (52 . 0.000000000000000) (53 . 0.000000000000000) (54 . 0.000000000000000) (51 . 0.000000000000000) (3 . "Standard") (100 . "AcDbAlignedDimension") (13 40.18507199535086 15.85661357694570 0.000000000000000) (14 46.37571167789080 16.75329605758096 0.000000000000000) (15 0.000000000000000 0.000000000000000 0.000000000000000) (16 0.000000000000000 0.000000000000000 0.000000000000000) (40 . 0.000000000000000) (50 . 0.000000000000000)))

Hatch=nil

Code: [Select]
(entmake '((0 . "HATCH") (100 . "AcDbEntity") (67 . 0) (8 . "hatch") (100 . "AcDbHatch") (10 0.000000000000000 0.000000000000000 0.000000000000000) (2 . "ANSI31") (70 . 0) (71 . 0) (91 . 1) (92 . 1) (93 . 1) (72 . 3) (10 58.78254566411708 15.38647030030781 0.000000000000000) (11 -0.449835770784768 -4.945370880901715 0.000000000000000) (40 . 0.672840038299498) (50 . 0.000000000000000) (51 . 6.283185307179587) (73 . 1) (97 . 0) (75 . 0) (76 . 1) (52 . 0.000000000000000) (41 . 1.000000000000000) (77 . 0) (78 . 1) (53 . 0.785398163397448) (43 . 0.000000000000000) (44 . 0.000000000000000) (45 . -0.088388347648318) (46 . 0.088388347648318) (79 . 0) (98 . 1) (10 0.000000000000000 0.000000000000000 0.000000000000000)))


Insert=nil

Code: [Select]
(entmake '((0 . "INSERT") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "block") (10 65.74896988234977 14.57482511261759 0.000000000000000) (41 . 1.000000000000000) (42 . 1.000000000000000) (43 . 1.000000000000000) (50 . 0.000000000000000) (70 . 0) (71 . 0) (44 . 0.000000000000000) (45 . 0.000000000000000)))

Mline=; error: Exception occurred: 0xC0000005 (Access Violation)

Code: [Select]
(entmake '((0 . "MLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbMline") (2 . "STANDARD") (40 . 1.000000000000000) (70 . 0) (71 . 1) (72 . 2) (73 . 2) (10 87.08685143261858 14.73982441426494 0.000000000000000) (11 87.08685143261858 14.73982441426494 0.000000000000000) (12 0.902734752513422 0.430197590189126 0.000000000000000) (13 -0.430197590189126 0.902734752513422 0.000000000000000) (74 . 2) (41 . 0.000000000000000) (41 . 0.000000000000000) (75 . 0) (74 . 2) (41 . -1.000000000000000) (41 . 0.000000000000000) (75 . 0) (11 92.20685489241603 17.17975834173619 0.000000000000000) (12 0.902734752513422 0.430197590189126 0.000000000000000) (13 -0.430197590189126 0.902734752513422 0.000000000000000) (74 . 2) (41 . 0.000000000000000) (41 . 0.000000000000000) (75 . 0) (74 . 2) (41 . -1.000000000000000) (41 . 0.000000000000000) (75 . 0)))

2dpolyline= runs but nothing is drawn

Code: [Select]
(entmake '((0 . "POLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDb2dPolyline") (66 . 1) (10 0.000000000000000 0.000000000000000 0.000000000000000) (70 . 130) (40 . 0.000000000000000) (41 . 0.000000000000000) (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)))


And the rest worked :)

HTH

Ron

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

MP

  • Seagull
  • Posts: 17446
ENTMAKE function
« Reply #28 on: April 19, 2005, 10:56:23 AM »
Note: updated the ToString function to make it a little more efficient; updated references to it as well (hope you don't mind Allen).
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
ENTMAKE function
« Reply #29 on: April 19, 2005, 04:51:27 PM »
OK, the Dimension requires that the dxf code 2 be removed.
The following code will work for Dimensions.
Remaining are :
Mline, something going on with dxf 2 I think, more research required.
The rest are complex objects and would require additional code.
A recursive call to the entstrip routine until the end of complex entity
is reached.

Again I am out of time...

I added the revised code from MP & added one more condition to strip trailing 0

Later Alligator...

Updated Code 04/19/2005 6:26pm est

Code: [Select]
;; here's a thing that can make entmakes of almost anything pulled from a drawing:
;; correction by CAB 11/19/04 - did not remove douplicate codes
;; CAB added removal of 340 410 210
;; MP revised removal code

(defun C:makeEntmake (/ idx dwg path ent entl fn sset dxfx replace)
  (defun replace (new old lst)
    (apply 'append (subst (list new) (list old) (mapcar 'list lst)))
  )
  (setq path (getvar "DWGPREFIX")
        dwg  (strcat path (vl-filename-base (getvar "DWGNAME")) ".lsp")
        fn   (open dwg "w")
        idx  0
  )
  (cond
    (fn
     (cond ((setq sset (ssget))
            (repeat (sslength sset)
              (setq ent  (ssname sset idx)
                    entl (entget ent)
                    dxfx (cond ((= (cdr(assoc 0 entl)) "DIMENSION")
                                '(-2 -1 2 5 102 300 330 331 340 350 360 210 410))
                               ((= (cdr(assoc 0 entl)) "HATCH")
                                '(-2 -1 5 102 300 330 331 340 350 360 410))
                               (t '(-2 -1 5 102 300 330 331 340 350 360 210 410)))
                    entl (vl-remove-if '(lambda (pair) (member (car pair) dxfx)) entL)
              )
              (cond
                ((= (cdr(assoc 0 entl)) "HATCH")
                 (setq entl (replace '(71 . 0) '(71 . 1) entl))
                 (setq entl (replace '(97 . 0) (assoc 97 entl) entl))
                )
              )
              (if (= (cdr(assoc 0 entl)) "MLINE")
                (prompt "\n***  Mline detected, not supported.  ***")              
                (write-line (strcat "(entmake '" (ToString entl) ")") fn)
              )
              (setq idx (1+ idx))
            )
           )
     )
     (close fn)
    )
  )
  (princ)
)

(defun ToString (x / typex)

  ;;  convert item to a string, if x is a real use
  ;;  the highest possible precision, if x is a
  ;;  string double quote it, if x is a list process
  ;;  each item in the list appropriatel, otherwise
  ;;  just hammer item with vl-princ-to-string

  (cond
    ;;  it's a string, return it double quoted
    ((eq 'str (setq typex (type x)))
     (strcat "\"" x "\"")
    )
    ;;  if n.0 do not add extra 0's
    ((and (eq 'real typex) (= (- x (fix x)) 0.0))
     (rtos x 2 1)
    )
    ;;  it's a real, covert to the highest possible
    ;;  resolution string equivalent
    ((eq 'real typex)
     (rtos x 2 (if (zerop (- x (fix x))) 1 15))
    )

    ;;  it's a list
    ((eq 'list typex)
     (if (vl-list-length x)
       ;;  it's a normal list
       (strcat
         (chr 40)
         (ToString (car x))
         (apply 'strcat
                (mapcar
                  '(lambda (x)
                     (strcat " " (ToString x))
                   )
                  (cdr x)
                )
         )
         (chr 41)
       )

       ;;  it's a dotted pair
       (strcat (chr 40) (ToString (car x)) " . " (ToString (cdr x)) (chr 41))
     )
    )

    ;;  hammer down on everything else
    ((vl-princ-to-string x))
  )
)

(prompt "\nEntity to lisp file loaded, Enter MakeEntitymake to run.")
(princ)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.