Author Topic: Entmake Ole2Frame Paitbrush image  (Read 5551 times)

0 Members and 1 Guest are viewing this topic.

FELIX

  • Bull Frog
  • Posts: 241
Entmake Ole2Frame Paitbrush image
« on: August 17, 2019, 11:20:44 PM »
How to create Entmake Ole2Frame Paitbrush image?
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #1 on: August 19, 2019, 09:04:26 AM »
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:

Code: [Select]
(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.
« Last Edit: August 19, 2019, 09:08:04 AM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #2 on: August 21, 2019, 05:10:19 PM »
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.
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #3 on: August 21, 2019, 05:48:31 PM »
Good to hear Felix - you're most welcome.

If you capture the image's dimensions before embedding it (example here) 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? :)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #4 on: August 25, 2019, 07:54:36 PM »
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?
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #5 on: August 25, 2019, 09:06:07 PM »
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.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #6 on: August 26, 2019, 11:07:20 AM »
Perfect, DXF 10 and 11.

Thank you.

ok.
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #7 on: August 26, 2019, 11:25:03 AM »
You’re welcome Felix.

Posting your vb code for others’ benefit would be a great way to say thanks. :)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #8 on: August 26, 2019, 11:45:51 AM »
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.
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #9 on: August 26, 2019, 11:51:55 AM »
Interesting + good luck +  (advance)thanks!
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #10 on: August 26, 2019, 11:27:45 PM »
Code Autolisp
Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
Code: [Select]
    <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
OK.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Entmake Ole2Frame Paitbrush image
« Reply #11 on: August 27, 2019, 08:41:11 AM »
Thanks for sharing Felix, will be interesting to compare to the c# variant when I get some time on my dev pc. Cheers.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #12 on: August 27, 2019, 10:16:01 AM »
For that you want to test directly follows ZIP file with VLX and DLL ready to use, test and comment.
OK.

ahsattarian

  • Newt
  • Posts: 112
Re: Entmake Ole2Frame Paitbrush image
« Reply #13 on: December 03, 2020, 01:17:45 PM »
fimgole   is not defined  !!!!     :



(FIMGOLE IMAGE-PATH image-angg)

FELIX

  • Bull Frog
  • Posts: 241
Re: Entmake Ole2Frame Paitbrush image
« Reply #14 on: December 03, 2020, 05:14:44 PM »
VB.NET

Code: [Select]
<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
OK.