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)