TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: FELIX on August 17, 2019, 11:20:44 PM
-
How to create Entmake Ole2Frame Paitbrush image?
-
it's challenging to create an ole image via entmake as the image data is stored as hex values in 310 groups (not revealed by entget). The image data is header info - bitmap values - then footer info. None (that I can tell) is documented. The bitmap value are relatively easy to crack but the header, footer info eludes me at present.
So what to do?
Kludegy work arounds include using powerscript to set the clipboard contents (have done before but it's a bit verbose) or a third party utility to perform same. Here is a quick and dirty example of the latter:
(defun embed-image ( image-path 2d-insert-point / cmdecho elast nircmd-path x y )
;; see: https://www.nirsoft.net/utils/nircmd.html
(and
(progn (setq elast (entlast)) t)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or
(setq nircmd-path (findfile "nircmd.exe"))
(setq nircmd-path (findfile "h:\\exe\\nircmd.exe")) ;; set to your installation location
)
(setq image-path (findfile image-path))
(progn
(startapp nircmd-path (strcat "clipboard copyimage \"" image-path "\""))
(command ".delay" 500) ;; may have to play with this value
(command ".pasteclip" (mapcar 'set '(x y) 2d-insert-point))
)
)
(setvar 'cmdecho cmdecho)
(not (equal elast (entlast)))
)
e.g.
(embed-image "H:\\sample-image.png" '(0.0 0.0))
<works on my machine>
Cheers.
-
Very well, it worked.
Now I will continue my program which is replacing referenced images with OLE images so that a DWG drawing file does not require external files when sent.
Replaces NIRCMD.EXE with a lispfunction DLL I made in VB.NET
Thank you very much.
OK.
-
Good to hear Felix - you're most welcome.
If you capture the image's dimensions before embedding it (example here (http://www.theswamp.org/index.php?topic=55362.msg595744#msg595744)) you can set the image size after embedding (it tends to be placed with an arbitrary scale that's a function of the current zoom factor - rarely will it reflect the original image size). Make sure to set the LockAspectRatio property to false before abusing the height and width for them to be accepted as is.
PS: I assume you're going to share your VB code like a good swamper? :)
-
Image dimensions are easy in .NET environment
It is only now missing the scaled value of the referenced IMAGE entity (in DXF) that will be replaced by the new OLE image.
Can you know the scale value in DXF of the IMAGE object?
-
Truth, I wrote a quick version in C# on Friday. After getting by a couple cast challenges (my C# is pretty rusty) it was stupid easy. Via lisp activex properties include height, width, scalewidth and scaleheight. In dxf the width and height can be determine by calculating the deltas between the 10 and 11 groups. The height and width are also stored in xdata (1040 groups). Either way, you know the original image dimensions one could determine the scale by comparing to the existing width and height.
-
Perfect, DXF 10 and 11.
Thank you.
ok.
-
You’re welcome Felix.
Posting your vb code for others’ benefit would be a great way to say thanks. :)
-
The utility to convert IMAGE to OLE is almost done.
I am still solving 2 problems as the image is georeferenced has a small rotation and the OLE will always be rectangular this results in a black background image and does not fit with the others.
The black background should be easy to solve in .NET as the plugin will try to minimize as much as possible.
Once you are done I will post here in this forum.
-
Interesting + good luck + (advance)thanks!
-
Code Autolisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:IMGOLE ()
(COMMAND "_UNDO" "_G")
(SETQ #CAD (SUBSTR (GETVAR "ACADVER") 1 2))
(COND
((= #CAD "17")(SETQ ARQUIVO "IMGOLENET3.DLL" ));ACAD 2007/2008/2009
((= #CAD "18")(SETQ ARQUIVO "IMGOLENET4.DLL" ));ACAD 2010/2011/2012
((= #CAD "19")(SETQ ARQUIVO "IMGOLENET4.DLL" ));ACAD 2013/2014
((= #CAD "20")(SETQ ARQUIVO "IMGOLENET45.DLL"));ACAD 2015/2016
((= #CAD "21")(SETQ ARQUIVO "IMGOLENET45.DLL"));ACAD 2017
((= #CAD "22")(SETQ ARQUIVO "IMGOLENET45.DLL"));ACAD 2018
((= #CAD "23")(SETQ ARQUIVO "IMGOLENET45.DLL"));ACAD 2019
( T (SETQ ARQUIVO "IMGOLENET45.DLL"));
)
(VL-CMDF "NETLOAD" (FINDFILE ARQUIVO))
;
(SETQ LLISTA (SSGET "_X" (LIST (CONS 0 "IMAGE") )))
(SETQ NN 0)
(IF LLISTA
(PROGN
(FOREACH EEP (SSNAMEX LLISTA)
(SETQ NN (+ NN 1))
(SETQ LL (ENTGET (CADR EEP)))
(SETQ PT (CDR (ASSOC 10 LL)))
(SETQ PT11 (CDR (ASSOC 11 LL)))
(SETQ PT12 (CDR (ASSOC 12 LL)))
(SETQ IMG (CDR (ASSOC 1 (ENTGET (CDR (ASSOC 340 LL))))))
(SETQ ANGG (RPG (ANGLE (LIST 0 0) PT11)))
(SETQ ANGG (- 360.0 ANGG))
(SETQ SCX (* 512 (DISTANCE (LIST 0 0) PT11)))
(SETQ SCY (* 512 (DISTANCE (LIST 0 0) PT12)))
(COMMAND "_IMAGE" "_D" (VL-FILENAME-BASE IMG))
(IMGPASTE IMG PT ANGG)
(SETQ ENTO (ENTLAST))
(SETQ LISO (ENTGET ENTO))
(SETQ PT10 (CDR (ASSOC 10 LISO)))
(SETQ PT11 (CDR (ASSOC 11 LISO)))
(SETQ DXO (- (CAR PT11) (CAR PT10)))
(SETQ DYO (- (CADR PT10) (CADR PT11)))
;
(COMMAND "_SCALE" ENTO "" PT (/ SCX DYO))
(COMMAND "_DRAWORDER" (ENTLAST) "" "_B")
)
(SETVAR "OLEFRAME" 0)
(COMMAND "_REGEN")
(ALERT (STRCAT ">> " (ITOA NN) " << IMAGES CONVERTEDS."
"\n"
"\nOLEFRAME (System Variable)"
"\n= 0 Frame is not displayed and not plotted"
"\n= 1 Frame is displayed and is plotted"
"\n= 2 Frame is displayed but is not plotted"
"\n"
"\nType U to back"
)
)
)
(ALERT (STRCAT ">> " (ITOA NN) " << IMAGES NOT FOUNDS."))
)
(COMMAND "_UNDO" "_E")
(PRINC)
)
;...
(defun IMGPASTE (image-path 2d-insert-point image-angg / cmdecho elast nircmd-path x y )
;;;www.theswamp.org by MP Seagull
(and
(progn (setq elast (entlast)) t)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq image-path (findfile image-path))
(progn
(FIMGOLE IMAGE-PATH image-angg) ;;;DLL
(command ".pasteclip" (mapcar 'set '(x y) 2d-insert-point))
)
)
(setvar 'cmdecho cmdecho)
(not (equal elast (entlast)))
)
;...
(DEFUN GPR ($G) (* $G (/ PI 180)) )
(DEFUN RPG ($R) (* $R (/ 180 PI)) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC)
Code VB.NET
<LispFunction("FIMGOLE")>
Public Function FIMGOLE(ByVal rbfArgs As ResultBuffer) As ResultBuffer
'
'>>>ARGUMENTOS DE ENTRADA
Dim arInputArgs As Array
arInputArgs = rbfArgs.AsArray
Dim MYIMG As String = CStr(CType(arInputArgs.GetValue(0), TypedValue).Value)
Dim MYANG As Single = CDbl(CType(arInputArgs.GetValue(1), TypedValue).Value)
'
Dim IMGTMP As String = Path.GetDirectoryName(MYIMG) & "\myimg.jpg"
Dim IMG As System.Drawing.Image = New Bitmap(MYIMG)
Dim retBMP As New Bitmap(IMG.Width + 5, IMG.Height + 5)
retBMP.SetResolution(IMG.HorizontalResolution, IMG.VerticalResolution)
Using g = Graphics.FromImage(retBMP)
g.TranslateTransform(0, IMG.Height)
g.RotateTransform(MYANG)
g.TranslateTransform(0, -IMG.Height)
g.DrawImage(IMG, New PointF(0, 0))
End Using
retBMP.Save(IMGTMP, ImageFormat.Jpeg)
'
Dim imge As Drawing.Image = Bitmap.FromFile(IMGTMP)
Dim mem As New IO.MemoryStream
imge.Save(mem, Imaging.ImageFormat.Jpeg)
imge.Dispose()
mem.Position = 0
imge = Drawing.Image.FromStream(mem)
Clipboard.SetImage(imge)
'
Dim rbfResult As ResultBuffer
rbfResult = New ResultBuffer(
New TypedValue(CInt(5005), MYIMG))
Return rbfResult
End Function
-
Thanks for sharing Felix, will be interesting to compare to the c# variant when I get some time on my dev pc. Cheers.
-
For that you want to test directly follows ZIP file with VLX and DLL ready to use, test and comment.
-
fimgole is not defined !!!! :
(FIMGOLE IMAGE-PATH image-angg)
-
VB.NET
<LispFunction("FIMGOLE")> _
Public Function FIMGOLE(ByVal rbfArgs As ResultBuffer) As ResultBuffer
'
'>>>ARGUMENTOS DE ENTRADA
Dim arInputArgs As Array
arInputArgs = rbfArgs.AsArray
Dim MYIMG As String = CStr(CType(arInputArgs.GetValue(0), TypedValue).Value)
Dim MYANG As Single = CSng(CType(arInputArgs.GetValue(1), TypedValue).Value)
'
Dim IMGTMP As String = Path.GetDirectoryName(MYIMG) & "\myimg.jpg"
Dim IMG As System.Drawing.Image = New Bitmap(MYIMG)
Dim DW, DH As Integer
If MYANG = 0 Then
DW = 0
DH = 0
Else
DW = 5
DH = 5
End If
Dim retBMP As New Bitmap(IMG.Width + DW, IMG.Height + DH)
retBMP.SetResolution(IMG.HorizontalResolution, IMG.VerticalResolution)
Using g = Graphics.FromImage(retBMP)
g.Clear(Drawing.Color.White)
g.TranslateTransform(0, IMG.Height)
g.RotateTransform(MYANG)
g.TranslateTransform(0, -IMG.Height)
g.DrawImage(IMG, New PointF(0, 0))
End Using
retBMP.Save(IMGTMP, ImageFormat.Jpeg)
'
Dim imge As Drawing.Image = Bitmap.FromFile(IMGTMP)
Dim mem As New IO.MemoryStream
imge.Save(mem, Imaging.ImageFormat.Jpeg)
imge.Dispose()
mem.Position = 0
imge = Drawing.Image.FromStream(mem)
Clipboard.SetImage(imge)
'
'<<<ARGUMENTOS DE SAIDA
'Use RTREAL (5001) for doubles
'Use RTSHORT (5003) for integers
'Use RTSTR (5005) for strings
Dim rbfResult As ResultBuffer
rbfResult = New ResultBuffer( _
New TypedValue(CInt(5005), MYIMG))
Return rbfResult
End Function
<LispFunction("FIMGIMP")> _
Public Function FIMGIMP(ByVal rbfArgs As ResultBuffer) As ResultBuffer
'
'>>>ARGUMENTOS DE ENTRADA
Dim arInputArgs As Array
arInputArgs = rbfArgs.AsArray
Dim MYSTR As String = CStr(CType(arInputArgs.GetValue(0), TypedValue).Value)
Dim MYIMG As String = CStr(CType(arInputArgs.GetValue(1), TypedValue).Value)
'
Try
Dim client As New WebClient()
'By default, the google static map api returns a png file
client.DownloadFile(MYSTR, MYIMG)
Catch
End Try
'
'<<<ARGUMENTOS DE SAIDA
'Use RTREAL (5001) for doubles
'Use RTSHORT (5003) for integers
'Use RTSTR (5005) for strings
Dim rbfResult As ResultBuffer
rbfResult = New ResultBuffer( _
New TypedValue(CInt(5005), MYIMG))
Return rbfResult
End Function
-
Thanks alot !!!
As I was Astonished to see such a program and as I'm LISP programmer,
Is it possible for u and Could U please offer it in AUTOLISP format !!!
Regards,
Amir