TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mark on April 18, 2005, 09:34:34 AM
-
Using 'entmake'. Is there something in the docs that can tell me what the minimum requirements are for a given entity when using this function?
Take the 'line' entity for example;
(
(-1 . <Entity name: 7efecb10>)
(0 . "LINE")
(330 . <Entity name: 7ef8fd18>)
(5 . "33BA")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbLine")
(10 512691.0 1.3465e+006 0.0)
(11 512455.0 1.3465e+006 0.0)
(210 0.0 0.0 1.0)
)
How much of the above do I *need* in order to create a line!
-
For all objects lose the -1, 5 and 330 groups.
For lines lose the 100 groups.
IIRC 8, 67, and 410 are optional but a good idea (will default to current space etc).
Entity types addded to AutoCAD 13 and later require the 100 groups, for example mtext.
Thus, this should work:
(entmake
'(
(0 . "LINE")
(10 512691.0 0.0 0.0)
(11 512455.0 0.0 0.0)
(210 0.0 0.0 1.0)
)
)
-
Thank MP. Can I assume then we have to use the values that are not listed as optional. Take the TEXT (http://www.autodesk.com/techpubs/autocad/acad2000/dxf/text_dxf_06.htm) DXF code for example.
-
Not necessarilly, as that listing does not identify the subclasss groups (100) as optional.
I would add that it doesn't hurt to include the 100 groups or any other 'optional groups'. Moreover, I believe it makes your intent clearer (yep, put this on layer "DIMS") and finally, there may be the day when entmake is not as casual about its requirements.
-
Oh, another opportunity for education... Minimum info for ENTMAKE.
In another thread we're talking about a routine for making text styles and layers. Maybe some gure here could "SIMPLY" explain ENTMAKE, and maybe how to entmake elements.
-
Well ... if one doesn't show up I'll be happy to pen a thread on this, but it won't be until this evening. I'll show how to entmake a block definition and then a subsequent insert of said def, c/w attributes on specific layers with specific styles. That should cover most of the bases.
If I've the time I'll also provide equivalent activex code. Yeah, I like that idea.
:)
-
Well ... if one doesn't show up I'll be happy to pen a thread on this, but it won't be until this evening. I'll show how to entmake a block definition and then a subsequent insert of said def, c/w attributes on specific layers with specific styles. That should cover most of the bases.
If I've the time I'll also provide equivalent activex code. Yeah, I like that idea.
:)
cool, I'll be waitin'
-
Not necessarilly, as that listing does not identify the subclasss groups (100) as optional.
Exactly, meaning we should use them because they're not listed as optional, even though they are.
I would add that it doesn't hurt to include the 100 groups or any other 'optional groups'. Moreover, I believe it makes your intent clearer (yep, put this on layer "DIMS") and finally, there may be the day when entmake is not as casual about its requirements.
No argument there. *grin*
-
In another thread we're talking about a routine for making text styles and layers...
umm ... coincidental 8)
-
I have some examples but would pale to anything Michael would come up with.
This is something I have been using for some time.
; 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 100 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 350 360 100 410 210); 100 410 210
(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)
)
-
These are what I have on the older native entities.
6 defualts to CELTYPE
8 defaults to CLAYER
39 deaults to THICKNESS
62 defaults to CECOLOR
210 deaults to '(0 0 1)
48 defaults to CELTSCALE
text attdef 11 is not always required but a good habit to use Make 11 = 10 when in doubt.
;*** = required field in (entmake)
(entmake (list (cons 0 "3DFACE") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 11 (list 1.0 0.0 0.0)) ;***
(cons 12 (list 0.0 1.0 0.0)) ;***
(cons 13 (list 1.0 1.0 0.0)) ;***
(cons 39 0.0)
(cons 62 256)
(cons 70 0)))
(entmake (list (cons 0 "ARC") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 1.0) ;***
(cons 50 0.0) ;***
(cons 51 1.57079633) ;***
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "ATTDEF") ;***
(cons 8 "0")
(cons 10 (list 0 0 0)) ;***
(cons 40 1) ;***
(cons 1 "") ;***
(cons 3 "") ;***
(cons 2 "TEST") ;***
(cons 70 0)
(cons 73 0)
(cons 50 0)
(cons 41 1)
(cons 51 0)
(cons 7 "STANDARD") ;***
(cons 71 0)
(cons 72 0)
(cons 11 (list 0 0 0)) ;***
(cons 210 (list 0 0 1))
(cons 74 0)
(cons 62 256)
(cons 39 0)
(cons 6 "BYLAYER")))
(entmake (list (cons 0 "CIRCLE") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 1.0) ;***
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "INSERT") ;***
(cons 2 "LEG6") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 41 1.0)
(cons 42 1.0)
(cons 43 1.0)
(cons 44 0.0)
(cons 45 0.0)
(cons 50 0.0)
(cons 62 256)
(cons 70 0)
(cons 71 0)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "INSERT") ;***
(cons 8 "0")
(cons 66 1) ;***
(cons 2 "CPD") ;***
(cons 10 (list 0 0 0)) ;***
(cons 41 1)
(cons 42 1)
(cons 50 0)
(cons 43 1)
(cons 70 0)
(cons 71 0)
(cons 44 0)
(cons 45 0)
(cons 210 (list 0 0 1))
(cons 62 256)
(cons 39 0)
(cons 6 "BYLAYER")))
(entmake (list (cons 0 "ATTRIB") ;***
(cons 8 "0")
(cons 10 (list 0 0 0)) ;***
(cons 40 1) ;***
(cons 1 "TESTING 123") ;***
(cons 2 "TAGNAME") ;***
(cons 70 0)
(cons 73 0)
(cons 50 0)
(cons 41 1)
(cons 51 0)
(cons 7 "STANDARD") ;***
(cons 71 0)
(cons 72 0)
(cons 11 (list 0 0 0)) ;***
(cons 210 (list 0 0 1))
(cons 74 0)
(cons 62 256)
(cons 39 0)
(cons 6 "BYLAYER")))
(entmake (list (cons 0 "SEQEND") ;***
(cons 8 "0")))
(entmake (list (cons 0 "LINE") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 11 (list 0.0 1.0 0.0)) ;***
(cons 39 0.0)
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "POLYLINE") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 0.0)
(cons 41 0.0)
(cons 62 256)
(cons 66 1)
(cons 70 0)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(cons 74 0)
(cons 75 0)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "VERTEX") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 50 0.0)
(cons 70 0)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(cons 74 0)
(cons 62 256)))
(entmake (list (cons 0 "VERTEX") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 1.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 50 0.0)
(cons 70 0)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(cons 74 0)
(cons 62 256)))
(entmake (list (cons 0 "SEQEND") ;***
(cons 8 "0")))
(entmake (list (cons 0 "POINT") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 50 0.0)
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "SOLID") ;***
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 11 (list 1.0 0.0 0.0)) ;***
(cons 12 (list 0.0 1.0 0.0)) ;***
(cons 13 (list 1.0 1.0 0.0)) ;***
(cons 39 0.0)
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "TEXT") ;***
(cons 1 "") ;***
(cons 6 "BYLAYER")
(cons 7 "STANDARD") ;***
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 11 (list 0.0 0.0 0.0)) ;***
(cons 39 0.0)
(cons 40 1.0) ;***
(cons 41 1.0)
(cons 50 0.0)
(cons 51 0.0)
(cons 62 256)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(cons 210 (list 0.0 0.0 1.0))))
(entmake (list (cons 0 "TRACE") ;***
(cons 6 "BYLAYER") ;***
(cons 8 "0")
(cons 10 (list 0.0 0.0 0.0)) ;***
(cons 11 (list 0.0 1.0 0.0)) ;***
(cons 12 (list 1.0 0.0 0.0)) ;***
(cons 13 (list 1.0 1.0 0.0)) ;***
(cons 39 0.0)
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))))
-David
-
Good stuff David, you should visit more often.
CAB, consider this alternative:
(vl-remove-if
'(lambda (pair)
(member (car pair)
'(-2 -1 5 102 300 330 331 350 360 100 210 410)
)
)
entityData
)
:)
-
Thanks MP - code revised.
Very nice David, it is a good start. Let's see what needs to be added. :)
;; 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 100 410 210
;; MP revised removal code
(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)
entl (vl-remove-if
'(lambda (pair)
(member (car pair)
'(-2 -1 5 102 300 330 331 350 360 100 210 410)
)
) entL
)
)
(write-line (strcat "(entmake '" (vl-prin1-to-string entl) ")") fn)
(setq a (1+ a))
)
)
)
(close fn)
)
)
(princ)
)
(prompt "\nEntity to lisp file loaded, Enter MakeEntitymake to run.")
(princ)
-
I've resisted the temptation to rewrite your utility Charles (nice one btw) but the way it's written it will strip precision from any reals.
I quickly wrote this (hope there's no errors), which you can incorporate, ignore or critique (or any combo thereof) ...
(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))
)
)
Might return a string like --
"( (0 . \"LINE\")
(67 . 0)
(8 . 0)
(10 512538.5490080543 -52.18808513476187 0)
(11 512606.286451516 -23.08692226341844 0)
)"
Assuming one stripped out non essential group codes first.
While it doesn't preserve the kind of numerical accuracy AutoCAD utilizes internally it's a wee bit better than what you get from a blanket vl-princ-to-string.
:)
Edit 1: Renamed function to 'ToString'.
Edit 2: Return strings double quoted.
Edit 3: Streamlined function.
Edit 4: Strip superfluous zeros
-
I've resisted rewriting your utility Charles but the way it's written it will strip precision from any reals.
I did not originate the routine, just made mods to it.
Any improvements are welcome.
Thanks
CAB
-
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.
-
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.
-
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.
(http://www.theswamp.org/screens/mp/moohaha.gif)
-
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.
(http://www.theswamp.org/screens/mp/moohaha.gif)
eh??
... omigosh DENT?
anyone seen Dent?
-
eh??
Randy speaks Canuckian, who knew?
10 9 8 ...
-
eh??
Randy speaks Canuckian, who knew?
spent 6 months in Calgary
10 9 8 ...
Where'd I put that chain-mail underwear???
-
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).
:)
-
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.
-
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
-
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.
;; 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)
)
-
Does this help Charles --
(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:
-
Aaaaah, That did it, Thanks MP :)
We still need Ron to test all the objects.
Old Code Removed, See later post...
-
Here is what I got with that latest routine:
(http://www.theswamp.org/screens/ronjonp/entities.jpg)
Dimension=nil
(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
(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
(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)
(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
(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
-
Note: updated the ToString function to make it a little more efficient; updated references to it as well (hope you don't mind Allen).
-
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
;; 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 changed the ToString def'n Alan, but I left your reference of it alone.
-
The Hatch is not a complex object as i stated but if it is associative it will not entmake.
So I removed the associative dxf flags & it will entmake a non-associate hatch.
I updated the code above.
-
I changed the ToString def'n Alan, but I left your reference of it alone.
Yea, I think we are in sync with the exception of my added zero remover. :)
-
Better look again.
:)
-
I did some research on entmake & Mline.
Conclusion, don't waste your time. It aint gonna happen. :shock:
-
Better look again.:)
Oh, you love an Easter egg hunt don't you. :)
I think this is the only difference
(rtos x 2 (if (zerop (- x (fix x))) 1 15))
-
Ta da!
:)
-
Here is a rewrite of the routine.
It will handle all the objects previously tested except mLines.
Additionally excluded are nested blocks, xrefs, Raster, Tolerance, XRecord
Other objects may also excluded if they are new in ACAD 2002+
Ron, if you are up for it please retest the objects you tested before to
confirm it is working. Thanks.
Note that Inserts will result in a block being created which does not create
the actual Insert. The actual Insert must be created by the end user.
MakeEntmake.lsp (http://theswamp.org/lilly_pond/cab/MakeEntmake.lsp?nossi=1)
-
CAB,
Here is the results for the latest test: (blank did not create)
(http://www.theswamp.org/screens/ronjonp/entities2.jpg)
HTH
Ron
-
OK Ron, lets try again,
Fixed Hatch, Dim & Attdef
I think Block works, NOTE, the eMake will create a BLOCK definition which does not create
a visible object in the drawing. You must INSERT the new block.
I guess I could take it a step further & create the INSERT code as well.
Not sure anyone will need that code, do you?
-
CAB,
Looks like you got it nailed down :).
(http://www.theswamp.org/screens/ronjonp/entities3.jpg)
It might be handy for the block entmake to insert the block for you.
Thanks,
Ron
-
CAB (or anyone else),
Is there a reason your routine won't make a block with attributes?
This is what is spits out:
(defun c:eMake ()
(entmake '((0 . "BLOCK")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbBlockReference")
(66 . 1)
(2 . "dtitle")
(10 0.0 0.0 0.0)
(70 . 0)
)
)
(entmake '((0 . "ATTDEF")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbText")
(10 6.309332955476622 0.395557539427431 0.0)
(40 . 0.100000000000000)
(1 . "N.T.S.")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "standard")
(71 . 0)
(72 . 2)
(11 6.752190098333765 0.395557539427431 0.0)
(100 . "AcDbAttributeDefinition")
(3 . "Scale:")
(2 . "SCALE")
(70 . 0)
(73 . 0)
(74 . 0)
)
)
(entmake '((0 . "ATTDEF")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbText")
(10 1.377632293917034 0.395557539427431 0.0)
(40 . 0.250000000000000)
(1 . "")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "standard")
(71 . 0)
(72 . 0)
(11 0.0 0.0 0.0)
(100 . "AcDbAttributeDefinition")
(3 . "Second line:")
(2 . "NAME2")
(70 . 0)
(73 . 0)
(74 . 0)
)
)
(entmake '((0 . "ATTDEF")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbText")
(10 1.377632293917034 0.770557539427431 0.0)
(40 . 0.250000000000000)
(1 . "")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "standard")
(71 . 0)
(72 . 0)
(11 0.0 0.0 0.0)
(100 . "AcDbAttributeDefinition")
(3 . "First line:")
(2 . "NAME1")
(70 . 0)
(73 . 0)
(74 . 0)
)
)
(entmake '((0 . "ATTDEF")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbText")
(10 0.652977042930451 0.639190527874698 0.0)
(40 . 0.250000000000000)
(1 . "")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "standard")
(71 . 0)
(72 . 4)
(11 0.750095051115990 0.764190527874698 0.0)
(100 . "AcDbAttributeDefinition")
(3 . "Number:")
(2 . "#")
(70 . 0)
(73 . 0)
(74 . 0)
)
)
(entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 3)
(70 . 0)
(43 . 0.020000000000000)
(38 . 0.0)
(39 . 0.0)
(10 1.245930039763611 0.721912612736174)
(40 . 0.020000000000000)
(41 . 0.020000000000000)
(42 . 1.064411829348489)
(10 0.252853063807763 0.744437955044491)
(40 . 0.020000000000000)
(41 . 0.020000000000000)
(42 . 0.947434764959047)
(10 1.245930039763611 0.721912612736174)
(40 . 0.020000000000000)
(41 . 0.020000000000000)
(42 . -0.926144858212555)
)
)
(entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 2)
(70 . 0)
(43 . 0.020000000000000)
(38 . 0.0)
(39 . 0.0)
(10 1.245930039763611 0.721912612736174)
(40 . 0.020000000000000)
(41 . 0.020000000000000)
(42 . 0.0)
(10 6.750564105741474 0.721912612736174)
(40 . 0.020000000000000)
(41 . 0.020000000000000)
(42 . 0.0)
)
)
(entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
(princ)
) ; end eMaker
Thanks,
Ron
-
Here is an update. :)
Fixed bug 8-)
<code removed: see link for latest version>
http://www.theswamp.org/index.php?topic=31145.0
-
CAB,
You are amazing! Thanks.
Ron
-
No problem & thanks.
The bug was that I used the (70 . 0) by default and the fix was to get the actual dxf 70 code
from the block data which in this case was (70 . 2)
-
An extremely useful routine, thanks CAB & all those that contributed.
I've noticed that 'eMaking' into another drawing however ignores objects originally drawn using linetypes and text styles that arent loaded in the new drawing. I've added a few more exceptions (see code) as a temporary fix.
If I ever get the time I may try including commands to re-define the text styles and load the relevant linetypes into a new drawing prior to processing all the entmakes.
(defun dxfstrip (ent / entl dxfx)
(setq entl (entget ent)
dxfx '(-2 -1 5 102 300 330 331 340 350 360 410)
;; additional codes to strip
dxfx (cond ((= (cdr (assoc 0 entl)) "DIMENSION")
(append dxfx '(2 210))
)
((= (cdr (assoc 0 entl)) "HATCH")
(append dxfx '(67))
)
((= (cdr (assoc 0 entl)) "INSERT")
(append dxfx '(40 41 42 43 44 45 50 71 210))
)
((= (cdr (assoc 0 entl)) "TEXT") ; remove text style, added by didge.
(append dxfx '(7))
)
((= (cdr (assoc 0 entl)) "LINE") ; remove linetype, added by didge.
(append dxfx '(6))
)
((= (cdr (assoc 0 entl)) "LWPOLYLINE") ; remove linetype, added by didge.
(append dxfx '(6))
)
(t (append dxfx '(210)))
)
entl (vl-remove-if '(lambda (pair) (member (car pair) dxfx)) entL)
)
;; CORRECTIONS FOR SPECIAL OBJECTS
(cond
;; Make Hatch Non-associative
((= (cdr (assoc 0 entl)) "HATCH")
(setq entl (replace '(71 . 0) '(71 . 1) entl))
(setq entl (replace '(97 . 0) (assoc 97 entl) entl))
(prompt "\n*** Warning Hatch created is Non-associative ***")
)
((= (cdr (assoc 0 entl)) "LEADER")
(prompt "\n*** Warning Leader created is Non-associative ***")
)
)
;; filter out objects that can not be created at this time
entl
) ; defun
-
An extremely useful routine, thanks CAB & all those that contributed.
I've noticed that 'eMaking' into another drawing however ignores objects originally drawn using linetypes and text styles that arent loaded in the new drawing. I've added a few more exceptions (see code) as a temporary fix.
If I ever get the time I may try including commands to re-define the text styles and load the relevant linetypes into a new drawing prior to processing all the entmakes.
Thanks Didge.
Is it necessary to you to remove them? Don't they just convert to the "Current" value in the drawing?
-
Don't they just convert to the "Current" value in the drawing?
No it seems like those particular entmakes are skipped, Current color values are used & Acad creates layers accordingly but it doesnt seem to load linetypes, even standard acad linetypes.
Its not a big problem, just another one of Acad's curios.
-
I spoke too soon, it looks like the issue may be with properties by entity because properties assigned <by layer> seem to work fine. Here's a small dwg to demonstrate.
-
I am surprised!
Unless still nobody wrote creation HATCH?
It is a simple variant, creations not associative hatch for contours from linear segments...
Contour are set by the list of points.
(defun entmakex-hatch (L)
;; By ElpanovEvgeniy
;; 03.04.2007 10:03:51:
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(2 . "SOLID")
'(70 . 1)
'(71 . 0)
(cons 91 (length l))
) ;_ list
(apply 'append
(mapcar '(lambda (a)
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
(mapcar '(lambda (b) (cons 10 b)) a)
'((97 . 0))
) ;_ list
) ;_ apply
) ;_ lambda
l
) ;_ mapcar
)
'((75 . 0)
(76 . 1)
(47 . 1.)
(98 . 2)
(10 0. 0. 0.0)
(10 0. 0. 0.0)
(451 . 0)
(460 . 0.0)
(461 . 0.0)
(452 . 1)
(462 . 1.0)
(453 . 2)
(463 . 0.0)
(463 . 1.0)
(470 . "LINEAR")
)
) ;_ list
) ;_ apply
) ;_ entmakex
)
test:
(setq h (entmakex-hatch
'(((538.794 584.563) (895.629 584.563) (895.629 997.377) (538.794 997.377))
((386.809 345.13) (670.955 345.13) (670.955 855.369) (386.809 855.369))
)
) ;_ entmakex-hatch
) ;_ setq
-
Here is an update. :)
Fixed bug 8-)
Alan
Wow, I just looked into this thread. This could REALLY come in handy.
Gary
-
Glad you found it Gary. :-)
Quite a gold mine around here, just happy I could contribute a few nuggets.
-
Evgeniy,
My routine will make a hatch. It does not support Associative hatches and therefore converts them to non associative.
-
Evgeniy,
My routine will make a hatch. It does not support Associative hatches and therefore converts them to non associative.
Alan
The only thing I would suggest you add is support for layer color and linetype.
Gary
-
Gary,
The routine keeps the existing info in tact, layer color & linetype.
If the drawing where you emtmake the new object is missing the layer and or line type then it uses the current.
Is that what you are referring to?
-
Gary,
The routine keeps the existing info in tact, layer color & linetype.
If the drawing where you emtmake the new object is missing the layer and or line type then it uses the current.
Is that what you are referring to?
Alan
I got to the party late, so I know I am missing some of good stuff...
I just did a simple test, see enclosed drawing. It did not pickup the color and linetype.
Gary
-
The three lines are "ByLayer" for color & line type. That information was the same for the entmake code.
Therefore the new objects created will rely on the Layer for those settings.
If the lines had an override on the color & line type it would have picked that up.
-
The three lines are "ByLayer" for color & line type. That information was the same for the entmake code.
Therefore the new objects created will rely on the Layer for those settings.
If the lines had an override on the color & line type it would have picked that up.
Thanks. I see that now.
Gary
-
Evgeniy,
My routine will make a hatch. It does not support Associative hatches and therefore converts them to non associative.
Probably, I have not understood your code...
I very much apologize!
Set an example, as it is possible to create hatch, having the list of points.
-
No apology necessary.
My code allows the user to select objects (ssget) and then generates a lisp file with the code needed to
recreate those objects. This is done by stripping the unwanted dxf codes from the entlist before writing
the list to the lisp file. The lisp file is named <dwg name>.lsp
Selecting a single hatch, the out put file would contain this:
;; Revision :04/04/2007 @09:45
(defun c:eMake ()
(entmake '((0 . "HATCH") (100 . "AcDbEntity") (8 . "WorkingLayer") (100 . "AcDbHatch")
(10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "ANSI31") (70 . 0) (71 . 0) (91 . 1) (92 . 7)
(72 . 1) (73 . 1) (93 . 6) (10 3840.362947224578 -895.4843925631022 0.0)
(42 . 0.414213562373095) (10 3722.341824578577 -777.4632699171016 0.0)
(42 . 0.0) (10 3359.224080572738 -777.4632699171018 0.0) (42 . 0.0)
(10 3359.224080572738 -1281.385497073226 0.0) (42 . 0.0)
(10 3722.341824578577 -1281.385497073226 0.0) (42 . 0.414213562373095)
(10 3840.362947224577 -1163.364374427225 0.0) (42 . 0.0) (97 . 0) (75 . 0)
(76 . 1) (52 . 0.0) (41 . 100.0) (77 . 0) (78 . 1) (53 . 0.785398163397448)
(43 . 0.0) (44 . 0.0) (45 . -8.838834764831842) (46 . 8.838834764831844)
(79 . 0) (47 . 1.702439943416909) (98 . 1) (10 3515.061971355171 -947.7072603540719 0.0)))
(princ)
) ; end eMaker
-
This is done by stripping the unwanted dxf codes from the entlist before writing the list to the lisp file.
What for?
It is possible to leave a full code - all will work!
For example, my variant of copying of objects on base LISP, as vla-copy
(entmakex(entget(car(entsel))))
-
Perhaps I have not understood the entmakex function.
In my test with entmake, some entities would not make unless I removed some of the dxf codes. Testing was done in ACAD2000.
Keep in mind that the entity list created by my routine are written to a lisp file and may be used to create the cloned entity in another drawing and or space.
I primarily use it to create an entmake to be added to a lisp routine so I can create the entity for the first time in a drawing.
Are you are telling me that if I use entmakex I may leave all the dxf codes in without penalty?
-
Are you are telling me that if I use entmakex I may leave all the dxf codes in without penalty?
Yes! :)
For 2004-2008 acad...
-
OK, that clears that up. Thanks.
I need to move into the present. :-) Or at least ACAD2006.
-
Creation of hatch with the instruction of a pattern, a angle and scale.
(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list point
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(2 . "ANSI31")
(if (= n "SOLID")
'(70 . 1)
'(70 . 0)
) ;_ if
'(71 . 0)
(cons 91 (length l))
) ;_ list
(apply 'append
(mapcar '(lambda (a)
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
(mapcar '(lambda (b) (cons 10 b)) a)
'((97 . 0))
) ;_ list
) ;_ apply
) ;_ lambda
l
) ;_ mapcar
) ;_ apply
(list '(75 . 0)
'(76 . 1)
(cons 52 a)
(cons 41 s)
'(77 . 0)
'(78 . 1)
(cons 53 a)
'(43 . 0.)
'(44 . 0.)
'(45 . 1.)
'(46 . 1.)
'(79 . 0)
'(47 . 1.)
'(98 . 2)
'(10 0. 0. 0.0)
'(10 0. 0. 0.0)
'(451 . 0)
'(460 . 0.0)
'(461 . 0.0)
'(452 . 1)
'(462 . 1.0)
'(453 . 2)
'(463 . 0.0)
'(463 . 1.0)
'(470 . "LINEAR")
) ;_ list
) ;_ list
) ;_ apply
) ;_ entmakex
) ;_ defun
Check:
(entmakex-hatch '(((538.794 584.563) (895.629 584.563) (895.629 997.377) (538.794 997.377))
((386.809 345.13) (670.955 345.13) (670.955 855.369) (386.809 855.369))
)
(/ pi 2)
"ANSI31"
2.
) ;_ entmakex-hatch
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel)))))
) ;_ list
(/ pi 2)
"ANSI31"
2.
)
-
OK, that clears that up. Thanks.
I need to move into the present. :-) Or at least ACAD2006.
I'm curious why you chose 2006 CAB?
2004 was blazing fast, 2006 added the cui but retained 2004 file formatting.
2007 refined use of the cui menu files created in 2006 and interface formatting had the maximum use for ToolPalette flexibility.
You could actually still export to xtp files for other users to import. Which was very beneficial in a network environment. The reason I mention those items for 2007 was you could actually use a routine like this to create a drawing that could then be used to export an entire tool palette of the objects in the drawing for use later through Design Center. Where it would be necessary I have not the foggiest but I'm sure people run into some obstacles this could shortcut considerably.
2008 disables the toolpalette export function...
-
Because I already own a copy of 2006 8-)
-
LOL gotcha! :lmao:
Pricing does have its woes.
I'm on subscription for 80 some licenses...talk about a major wallet hole that is.... :-o
Thanks CAB
-
THIS IS AMAZING, THANKS FOR SHARING, NOW I DONT HAVE TO WORRY IN MY ENTMAKE.
-
Dear CAB,
what difference between your function replace and Subst?tks!
-
Been too long ago for my short memory, I'll have to look at it on Monday.
-
Been too long ago for my short memory, I'll have to look at it on Monday.
Ｍany monday have past!
-
Many moons have past. 8-)
Looks like they do the same thing.
-
Emake Wipeouts (http://discussion.autodesk.com/forums/thread.jspa?threadID=518101&tstart=8055)
Thanks to Joe Burke and Gile and a bit of TT I believe
Works great, not sure which versions it works in. Maybe some testing will tell.
-
Helo Cab,
I want to use your lisp entmake with a macro to insert some objects in a drawing. When i generate the lisp that create those objects, i move them somewhere centered to 0,0,0 point - origin. I do this because i want to insert those object in a point that i will select on the drawing - and always those objects are drawn in their original locations, even if i change my ucs (with a small lisp). How can i insert those objects created with your entmake lisp in a point chosen on the drawing? Thanks!
-
Get the latest function here: http://www.theswamp.org/index.php?topic=31145
You will need to use something like this: [just an example, no error checking]
(defun c:test(/ LowerLeft LastEnt NewEnts)
(vl-load-com)
;; CAB version 03.01.2008
;; returns a list of enames and not a selection set.
;; CAB - get last entity in datatbase
;; An entity name, or nil, if there are no entities in the current drawing.
(defun GetLastEnt ( / ename result )
(if (setq result (entlast))
(while (setq ename (entnext result))
(setq result ename)
)
)
result
)
;; CAB 09.17.08 - return a list of new enames
;; if ename is nil then return all objects in DWG
(defun GetNewEntities (ename / new)
(cond
((or (null ename) (null (setq new (list (entnext))))))
((eq 'ENAME (type ename))
(while (setq ename (entnext ename))
(if (entget ename) (setq new (cons ename new)))
)
)
; ((alert "Ename wrong type."))
)
new
)
;; returns a point list in WCS coordinates ((lower left)(upper right))
(defun boundingbox (lst / ptlst mnpt mxpt)
(mapcar '(lambda (x)
(vla-getboundingbox (vlax-ename->vla-object x) 'mnpt 'mxpt)
(setq ptlst (cons (vlax-safearray->list mnpt) ptlst))
(setq ptlst (cons (vlax-safearray->list mxpt) ptlst))
)
lst
)
;;following by Tony Tanzillo
(list
(apply 'mapcar (cons 'min ptlst))
(apply 'mapcar (cons 'max ptlst))
)
)
(setq LastEnt (GetLastEnt))
(c:eMake)
(setq NewEnts (vl-remove-if '(lambda(x) (= "VIEWPORT" (cdr (assoc 0 (entget x))))) (GetNewEntities LastEnt)))
(setq LowerLeft (car (boundingbox NewEnts)))
(command "._move")
(mapcar 'command NewEnts)
(command "" "_non" LowerLeft)
)
-
Creation of hatch with the instruction of a pattern, a angle and scale.
(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list point
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
[color=red] '(2 . "ANSI31")[/color]
(if (= n "SOLID")
'(70 . 1)
'(70 . 0)
) ;_ if
'(71 . 0)
(cons 91 (length l))
) ;_ list
(apply 'append
(mapcar '(lambda (a)
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
(mapcar '(lambda (b) (cons 10 b)) a)
'((97 . 0))
) ;_ list
) ;_ apply
) ;_ lambda
l
) ;_ mapcar
) ;_ apply
(list '(75 . 0)
'(76 . 1)
(cons 52 a)
(cons 41 s)
'(77 . 0)
'(78 . 1)
(cons 53 a)
'(43 . 0.)
'(44 . 0.)
'(45 . 1.)
'(46 . 1.)
'(79 . 0)
'(47 . 1.)
'(98 . 2)
'(10 0. 0. 0.0)
'(10 0. 0. 0.0)
'(451 . 0)
'(460 . 0.0)
'(461 . 0.0)
'(452 . 1)
'(462 . 1.0)
'(453 . 2)
'(463 . 0.0)
'(463 . 1.0)
'(470 . "LINEAR")
) ;_ list
) ;_ list
) ;_ apply
) ;_ entmakex
) ;_ defun
Little correct for solid hatch
(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list of list point. like ((pt11 pt12 pt13)(pt21 pt22 pt23))
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
;;USE
;|
(entmakex-hatch '(((538.794 584.563) (895.629 584.563) (895.629 997.377) (538.794 997.377))
((386.809 345.13) (670.955 345.13) (670.955 855.369) (386.809 855.369))
)
(/ pi 2)
"ANSI31"
2.
) ;_ entmakex-hatch
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"SOLID"
2.
)
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"ANSI31"
2.
)
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"ANSI32"
2.
)
|;
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
(cons 2 n)
(if (= n "SOLID")
'(70 . 1)
'(70 . 0)
) ;_ if
'(71 . 0)
(cons 91 (length l))
) ;_ list
(apply 'append
(mapcar '(lambda (a)
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
(mapcar '(lambda (b) (cons 10 b)) a)
'((97 . 0))
) ;_ list
) ;_ apply
) ;_ lambda
l
) ;_ mapcar
) ;_ apply
(if (= n "SOLID")
(list '(75 . 0)
'(76 . 1)
;;; (cons 52 a)
;;; (cons 41 s)
;;; '(77 . 0)
;;; '(78 . 1)
;;; (cons 53 a)
;;; '(43 . 0.)
;;; '(44 . 0.)
;;; '(45 . 1.)
;;; '(46 . 1.)
;;; '(79 . 0)
'(47 . 1.)
'(98 . 2)
'(10 0. 0. 0.0)
'(10 0. 0. 0.0)
'(450 . 0)
'(451 . 0)
'(460 . 0.0)
'(461 . 0.0)
'(452 . 0)
'(462 . 0.0)
'(453 . 2)
'(463 . 0.0)
'(63 . 256)
'(463 . 1.0)
'(63 . 256)
'(470 . "LINEAR")
) ;_ list
(list '(75 . 0)
'(76 . 1)
(cons 52 a)
(cons 41 s)
'(77 . 0)
'(78 . 1)
(cons 53 a)
'(43 . 0.)
'(44 . 0.)
'(45 . 1.)
'(46 . 1.)
'(79 . 0)
'(47 . 1.)
'(98 . 2)
'(10 0. 0. 0.0)
'(10 0. 0. 0.0)
;;; '(451 . 0)
;;; '(460 . 0.0)
;;; '(461 . 0.0)
;;; '(452 . 1)
;;; '(462 . 1.0)
;;; '(453 . 2)
;;; '(463 . 0.0)
;;; '(463 . 1.0)
'(470 . "LINEAR")
) ;_ list
)
) ;_ list
) ;_ apply
) ;_ entmakex
) ;_ defun
Use:
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"SOLID"
2.
)
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"ANSI31"
2.
)
(entmakex-hatch
(list
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_ list
(/ pi 2)
"ANSI32"
2.
)
-
A lot of useful examples .thanks!
-
Glad to help. Enjoy your stay here at the Swamp. 8)
-
Glad to help. Enjoy your stay here at the Swamp. 8)
Thanks CAB. :wink: