把command改为entmake是一方面，但还不能根本解决问题
一般情况下，不先插入图片不知道它的大小，所以不可能直接通过entmake一次到位，所以这又是矛盾的
不过在windows下我们点中一张图片是可以知道它的长宽的，所以还得通过windows api事先获取它的大小来一步到位
总的说来,图片的插入本来就不会快，跟图片的大小和硬件很有关系，不过只要事先获取了它的大小计算出比例通过ENTMAK一次到位会快很多
通过api获取图片大小在网上找了一个，不过得需要高手把它写为LISP能调用的才行
//====================================================================
// 函数: of_getpicturesize()
//--------------------------------------------------------------------
// 描述: 获得图片文件的图像尺寸大小(支持GIF,JPG,BMP格式)
//--------------------------------------------------------------------
// 参数:
//value stringas_FileName 图片文件名称
//referencelongal_PictureWidth 返回图片宽度
//referencelongal_PictureHeight返回图片高度
//--------------------------------------------------------------------
// 返回值:integer1 - 成功,0 - 失败
//--------------------------------------------------------------------
Integer li_File, li_DataRead
Blob lb_Data
Long ll_FileLength,ll_PictureWidth,ll_PictureHeight
Long ll_DataLen,ll_DataPos,ll_FilePos
Boolean lb_LoopFlag = True
Char lc_Char1,lc_Char2
//文件不存在
If Not FileExists(as_FileName) Then Return 0
//取文件大小
ll_FileLength = FileLength(as_FileName)
//打开文件
li_File = FileOpen(as_FileName,StreamMode!)
If li_File = -1 Then Return 0
//读取文件
li_DataRead = FileRead(li_File,lb_Data)
If li_DataRead <= 0 Then
FileClose(li_File)
Return 0
End If
// GIF目前主要有两种类型
// 1. 标识为GIF87a, 只是用来存储单幅静止图像
// 2. 标识为GIF89a, 可以同时存储若干幅静止图像并进而形成连续的动画
// 文件的前 6 个字节为标识:GIF87a 或 GIF89a, 第 7,8 字节为图像宽度(width),
// 第 9,10 字节为图像高度(height), 注意两个字节中低位在前
// GIF 文件格式判断
If String(BlobMid(lb_Data,1,4)) = 'GIF8' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,7,1))) + Asc(String(BlobMid(lb_Data,8,1))) *
256
ll_PictureHeight = Asc(String(BlobMid(lb_Data,9,1))) + Asc(String(BlobMid(lb_Data,10,1)))
* 256
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If
// JPEG文件格式
// 前 3 个字节为标识: 0xFF,0xD8,0xFF
If String(BlobMid(lb_Data,1,3)) = Char(255) + Char(216) + Char(255) Then
ll_DataLen = Len(lb_Data)
ll_DataPos = 3
ll_FilePos = 3
Do While lb_LoopFlag
ll_DataPos = ll_DataPos + 1
ll_FilePos = ll_FilePos + 1
lc_Char1 = String(BlobMid(lb_Data,ll_DataPos,1))
lc_Char2 = String(BlobMid(lb_Data,ll_DataPos + 1,1))
If lc_Char1 = Char(255) And lc_Char2 <> Char(255) Then
If lc_Char2 >= Char(192) And lc_Char2 <= Char(195) Then
//找到尺寸数据
ll_PictureWidth = Asc(String(BlobMid(lb_Data,ll_DataPos + 7,1))) *
256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 8,1)))
ll_PictureHeight = Asc(String(BlobMid(lb_Data,ll_DataPos + 5,1)))
* 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 6,1)))
lb_LoopFlag = False
Else
//没有找到尺寸数据,重新读取文件
ll_FilePos = ll_FilePos + Asc(String(BlobMid(lb_Data,ll_DataPos +
3,1))) * 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 2,1))) + 1
If ll_FilePos > ll_FileLength Then
FileClose(li_File)
Return 0
Else
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
End If
End If
If ll_DataPos = ll_DataLen - 9 And lb_LoopFlag = True Then
ll_FilePos = ll_FilePos - 9
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
If ll_FilePos >= ll_FileLength Then
lb_LoopFlag = False
End If
Loop
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If
// BMP文件格式
// 前两个字节是标识:标识可能有很多种
// 第 19,20,21,22 字节为宽度(width), 第 23,24,25,26 字节为高度(height)
// 四个字节组成dword, 低位在前
If String(BlobMid(lb_Data,1,2)) = 'BM' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,19,1))) + Asc(String(BlobMid(lb_Data,20,1)))
* 256 + Asc(String(BlobMid(lb_Data,21,1))) * 65536 + Asc(String(BlobMid(lb_Data,22,1))) * 16777216
ll_PictureHeight = Asc(String(BlobMid(lb_Data,23,1))) + Asc(String(BlobMid(lb_Data,24,1)))
* 256 + Asc(String(BlobMid(lb_Data,25,1))) * 65536 + Asc(String(BlobMid(lb_Data,26,1))) * 16777216
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
////将图像的真实大小转换为PBUnit大小，并返回
//al_PictureWidth = PixelsToUnits(ll_PictureWidth,XPixelsToUnits!)
//al_PictureHeight = PixelsToUnits(ll_PictureHeight,YPixelsToUnits!)
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If
Return 0
li_sheng大侠的程序是用什么编的，能否提示下，这样可以继续学习。这段程序调了许多日子了，但是就是调不稳定，有时候运行一次出来了，第二次运行又不行了，只要一提示图片的次序，不如缺省值写着<29>后面的就不能再次运行，不知道如何来解决。
另外ysq101大侠的指点我也会去试一试，那些princ的语句主要是当初为调试程序用的，用它来直接看程序运行到哪儿卡壳了，我一直习惯用这个方法调试程序的。
非常感谢大家的帮忙。
学海无涯，我会继续努力了，也希望得到大家的支持！ (defun c:inimageL (/ fname fim strname imd word chklay image
image_angle die_angle scale_dim die_center die_center_asist
tape_center_asist center_dimchksty n1 n2 Imagelayer ent1
layerIm ssimage n n_cir n_line n_arc en endata entype image_num
x_number y_number image_xspace image_yspace begpoint p1 p2
txt_high enscal data01 data02 data00 enscal01 k1 axi_point word ratio01)
(setvar "CMDECHO" 0)
(setq image_num (getreal "\n Input image numbers: ")) ;图片总数量输入
(setq x_number (fix (sqrt image_num))) ;图片X 方向分布数量
;(princ "\n x-num: ")
;(princ x_number)
(setq y_number (+ (fix (/ image_num x_number)) 1))
; 图片Y 方向的分布数量
(setq image_xspace (getreal "\n Input X-distance for every image: "))
;输入图片X方向占据的空间
(setq image_yspace (getreal "\n Input Y-distance for every image: "))
;输入图片Y 方向占据的空间
;(princ "\n image xspace: ")
;(princ image_xspace)
(setq txt_high (* image_yspace 0.1)) ;输入写入图片的文字高度
;(princ "\n TextHeight:")
;(princ txt_high)
(setq image_size (* image_xspace 0.7)) ; 写入图片初步放大到的尺寸
;(princ "\n Image_size:")
;(princ image_size)
(setq begpoint (getpoint "\n Input begin position: \n "))
;输入图片占据的起始点
(princ "\n Please Input Your Drawing Number List")
(setq fname (getfiled "Pls input file name" "" "pot" 8))
(setq fim (open fname "r"))
(setq strname (read-line fim))
(setq word (read strname)) ;读读取字符
;(princ "\n 读取字符")
;(princ strname)
(setq imd (strlen strname))
(setq n2 0 k1 0 nx1 0 ny1 0)
(while (/= imd 0)
;(prin1 strname)
;(prin1 "\n123")
;(prin1 "\n123")
;(setq word (strcatstrname ))
;(setq aa " "strname"")
;(princ aa)
;(prin1 "\n 123")
; (princ "\n x_number & nx1:")
; (princ x_number)
; (princ " & ")
; (princ nx1)
(setq nx1 (- k1 (* (fix (/ k1 x_number)) x_number))) ;Get x number
; (princ "\n nx1&n ")
; (princ nx1)
; (princ " & ")
; (princ k1)
(setq ny1(fix (/ n2 x_number))) ;Get y number
(setq x1 (car begpoint)) ;Get begpoint x vaule
(setq y1 (cadr begpoint)) ;Get begpoint y value
(setq x (+ x1 (* nx1 image_xspace)))
(setq y (- y1 (* ny1 image_yspace)))
(setq axi_point (list x y))
(princ "\n 插入点: ")
; (princ axi_point)
; (princ "\n 输入字符 : ")
; (princ word)
(command "-image" "attach" word axi_point 1 0)
(setq enscal01 (entlast))
(setq enscal (entget (entlast))) ;计算该图片需要放大的粗略倍数
(setq data01 (mapcar '(lambda (x) (* x image_size)) (cdr (assoc 11 enscal))))
(setq data02 (mapcar '(lambda (x) (* x image_size)) (cdr (assoc 12 enscal))))
; (setq data00 (* data01 data02))
; (setq ratio01 (/ image_size data00))
(setq enscal (subst (cons 11 data01) (assoc 11 enscal) enscal))
(entmod (subst (cons 12 data02) (assoc 12 enscal) enscal))
; (princ "\n 放大倍率:")
; (princ ratio01)
; (command "scale" enscal01 "" axi_point ratio01) ;放大倍率
(command "text" axi_point txt_high "" word ""); 图名写入图片上
; (princ word)
(setq strname (read-line fim)) ;读一行
(setq imd (strlen strname));返回字符串的个数
(setq word (read strname)) ;读取字符
(setq k1 (1+ k1))
(setq n2 (1+ n2))
)
(close fim)
(setvar "CMDECHO" 1)
(prompt "\n All rights belong to Tengo ")
(princ)
)
llsheng_73 发表于 2014-7-21 02:59 static/image/common/back.gif
把command改为entmake是一方面，但还不能根本解决问题
一般情况下，不先插入图片不知道它的大小，所以不可 ...
也找了个模块。
'***************************************************
'* 模 块 名：mdLSPicSize
'* 功能描述：读取图片尺寸信息(不加载图片，支持PNG)
'* 作 者：米兰
'* 作者博客：http://www.millerlee.com
'* 日 期：2012-01-21 21:39
'* 版 本：V1.0.0
'***************************************************
'整行注释的为在读取图片尺寸时不需要的文件头信息
'BMP文件头
Private Type BitmapFileHeader
bfType As Integer '标识 0,1 两个字节为 42 4D 低位在前，即 19778
bfReserved2 As Integer
bfOffBits As Long
bfReserved1 As Integer
bfSize As Long
End Type
Private Type BitmapInfoHeader
biSize As Long
biWidth As Long '宽度 18,19,20,21 四个字节，低位在前
biHeight As Long '高度 22,23,24,25 四个字节，低位在前
'biPlanes As Integer
'biBitCount As Integer
'biCompression As Long
'biSizeImage As Long
'biXPelsPerMeter As Long
'biYPelsPerMeter As Long
'biClrUsed As Long
'biClrImportant As Long
End Type
'JPEG（这个好麻烦）
Private Type LSJPEGHeader
jSOI As Integer '图像开始标识 0,1 两个字节为 FF D8 低位在前，即 -9985
jAPP0 As Integer 'APP0块标识 2,3 两个字节为 FF E0
jAPP0Length(1)As Byte 'APP0块标识后的长度，两个字节，高位在前
'jJFIFName As Long 'JFIF标识 49(J) 48(F) 44(I) 52(F)
'jJFIFVer1 As Byte 'JFIF版本
'jJFIFVer2 As Byte 'JFIF版本
'jJFIFVer3 As Byte 'JFIF版本
'jJFIFUnit As Byte
'jJFIFX As Integer
'jJFIFY As Integer
'jJFIFsX As Byte
'jJFIFsY As Byte
End Type
Private Type LSJPEGChunk
jcType As Integer '标识（按顺序）：APPn(0,1~15)为 FF E1~FF EF; DQT为 FF DB(-9217)
'SOFn(0~3)为 FF C0(-16129),FF C1(-15873),FF C2(-15617),FF C3(-15361)
'DHT为 FF C4(-15105); 图像数据开始为 FF DA
jcLength(1) As Byte '标识后的长度，两个字节，高位在前
'若标识为SOFn，则读取以下信息；否则按照长度跳过，读下一块
jBlock As Byte '数据采样块大小 08 or 0C or 10
jHeight(1) As Byte '高度两个字节，高位在前
jWidth(1) As Byte '宽度两个字节，高位在前
'jColorType As Byte '颜色类型 03，后跟9字节，然后是DHT
End Type
'PNG文件头
Private Type LSPNGHeader
pType As Long '标识 0,1,2,3 四个字节为 89 50(P) 4E(N) 47(G) 低位在前，即 1196314761
pType2 As Long '标识 4,5,6,7 四个字节为 0D 0A 1A 0A
pIHDRLength As Long 'IHDR块标识后的长度，疑似固定 00 0D，高位在前，即 13
pIHDRName As Long 'IHDR块标识 49(I) 48(H) 44(D) 52(R)
pWidth(3) As Byte '宽度 16,17,18,19 四个字节，高位在前
pHeight(3) As Byte '高度 20,21,22,23 四个字节，高位在前
'pBitDepth As Byte
'pColorType As Byte
'pCompress As Byte
'pFilter As Byte
'pInterlace As Byte
End Type
'GIF文件头（这个好简单）
Private Type LSGIFHeader
gType1 As Long '标识 0,1,2,3 四个字节为 47(G) 49(I) 46(F) 38(8) 低位在前，即 944130375
gType2 As Integer '版本 4,5 两个字节为 7a单幅静止图像9a若干幅图像形成连续动画
gWidth As Integer '宽度 6,7 两个字节，低位在前
gHeight As Integer '高度 8,9 两个字节，低位在前
End Type
Public Function PictureSize(ByVal picPath As String, ByRef Width As Long, ByRef Height As Long) As String
Dim iFile As Integer
Dim jpg As LSJPEGHeader
Width = 0: Height = 0 '预输出：0 * 0
If picPath = "" Then PictureSize = "null": Exit Function '文件路径为空
If Dir(picPath) = "" Then PictureSize = "not exist": Exit Function '文件不存在
PictureSize = "error" '预定义：出错
iFile = FreeFile()
Open picPath For Binary Access Read As #iFile
Get #iFile, , jpg
If jpg.jSOI = -9985 Then
Dim jpg2 As LSJPEGChunk, pass As Long
pass = 5 + jpg.jAPP0Length(0) * 256 + jpg.jAPP0Length(1) '高位在前的计算方法
PictureSize = "JPEG error" 'JPEG分析出错
Do
Get #iFile, pass, jpg2
If jpg2.jcType = -16129 Or jpg2.jcType = -15873 Or jpg2.jcType = -15617 Or jpg2.jcType = -15361 Then
Width = jpg2.jWidth(0) * 256 + jpg2.jWidth(1)
Height = jpg2.jHeight(0) * 256 + jpg2.jHeight(1)
PictureSize = "JPEG"'JPEG分析成功
Exit Do
End If
pass = pass + jpg2.jcLength(0) * 256 + jpg2.jcLength(1) + 2
Loop While jpg2.jcType <> -15105 'And pass < LOF(iFile)
ElseIf jpg.jSOI = 19778 Then
Dim bmp As BitmapInfoHeader
Get #iFile, 15, bmp
Width = bmp.biWidth
Height = bmp.biHeight
PictureSize = "BMP" 'BMP分析成功
Else
Dim png As LSPNGHeader
Get #iFile, 1, png
If png.pType = 1196314761 Then
Width = png.pWidth(0) * 16777216 + png.pWidth(1) * 65536 + png.pWidth(2) * 256 + png.pWidth(3)
Height = png.pHeight(0) * 16777216 + png.pHeight(1) * 65536 + png.pHeight(2) * 256 + png.pHeight(3)
PictureSize = "PNG" 'PNG分析成功
ElseIf png.pType = 944130375 Then
Dim gif As LSGIFHeader
Get #iFile, 1, gif
Width = gif.gWidth
Height = gif.gHeight
PictureSize = "GIF" 'GIF分析成功
Else
PictureSize = "unknow" '文件类型未知
End If
End If
Close #iFile
End Function
Sub test()
Dim w As Long, h As Long
Dim f As String
Dim t As String
f = ThisWorkbook.Path & "\a.png"
t = PictureSize(f, w, h) '运行宏，w，h就是对应图片的width height
End Sub
(defun c:incircle01 (/ image_numx_number y_number
image_xspace image_yspace
txt_high begpoint fname fim
strname imd n1 k1
nx1 ny1 x_number word
axi_point x y
)
(setvar "CMDECHO" 0)
(setq image_num (getreal "\n Input image numbers: ")) ;图片总数量输入
(setq x_number (fix (sqrt image_num))) ;图片X 方向分布数量
(setq y_number (+ (fix (/ image_num x_number)) 1))
; 图片Y 方向的分布数量
(setq image_xspace (getreal "\n Input X-distance for every image: "))
;输入图片X方向占据的空间
(setq image_yspace (getreal "\n Input Y-distance for every image: "))
;输入图片Y 方向占据的空间
(setq txt_high (* image_yspace 0.1)) ;输入写入图片的文字高度
(setq image_size (* image_xspace 0.7)) ; 写入图片初步放大到的尺寸
(setq begpoint (getpoint "\n Input begin position: \n "))
;输入图片占据的起始点
(setq fname (getfiled "Pls input file name"
"C:\\Users\\zhengzhi\\Desktop\\ZZR\\"
"pot"
8
)
)
(setq fim (open fname "r"))
(setq strname (read-line fim))
(setq imd (strlen strname))
(setq word (read strname)) ;该行字符赋予word
(princ word)
(setq n2 0
k1 0
nx1 0
ny1 0
)
(while (/= imd 0)
(setq nx1 (- k1 (* (fix (/ k1 x_number)) x_number)))
;Get x number
(setq ny1 (fix (/ n2 x_number))) ;Get y number
(setq x1 (car begpoint)) ;Get begpoint x vaule
(setq y1 (cadr begpoint)) ;Get begpoint y value
(setq x (+ x1 (* nx1 image_xspace)))
(setq y (- y1 (* ny1 image_yspace)))
(setq axi_point (list x y))
(command "circle" axi_point 2)
(command "text" axi_point txt_high "" word "") ; 图名写入图片上
(setq strname (read-line fim)) ;读一行
(setq word (read strname))
(setq imd (strlen strname)) ;返回字符串的个数
(setq k1 (1+ k1))
(setq n2 (1+ n2))
)
(close fim)
(setvar "CMDECHO" 1)
(prompt "\n All rights belong to Tengo ")
)
各位大侠好：
上面的程序是能够运行的，我把图片输入命令去掉了，但是仅仅画圆与写入文件字内容（见附件里面的内容，并用附件里面内容作为读取来判断），但是执行起来还是异常的慢，真的搞不懂哪里出了问题了。
大侠给出的程序超出了我的知识范围，目前暂时没有读懂，我记下了，后续会继续学习。
如果能够解决这个程序慢的问题，万分感激。 还有没有大侠能够帮帮我？
页:
1
[2]