请问以下这段函数在lisp程序中调用时，有的电脑能调用，有的不能、选择文件对话框...
请问以下这段函数在lisp程序中调用时，有的电脑能调用，有的不能、选择文件对话框都不出现，是什么原因呢？(defun getfiles (/ x erg);获取文件的路径和文件名一个文件返回后路径和文件名之间无空格分开，格式“d:\\1.dwg”.两个以上文件返回后路径和文件名之间有空格分开格式“d:\\ 1.dwg 2.dwg ...”
(vl-registry-write
"HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905"
""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
(if (setq x (vlax-create-object "MSComDlg.CommonDialog"))
(progn (vlax-put-property x "DialogTitle" "选择图形文件")
(vlax-put-property x "Filename" "*.dwg")
(vlax-put-property x "Filter" "*.dwg")
(vlax-put-property x "MaxFileSize" 10000)
(vlax-put-property x "Flags" 512)
(vlax-put-property x "Action" 1);_ showopen-dialog
(setq erg (vlax-get-property x "Filename"))
)
nil
)
)
本帖最后由 ZZXXQQ 于 2017-10-11 14:45 编辑
完整的程序如下，批量合并cad图程序
(defun c:hb()
(setq OS_OLD (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(vl-load-com)
(setq erg (getfiles));选择图形文件，传回文件路径
(setq tc (strcase (getstring "指定需冻结的图层名[如(9110,8110,8300),(N)表不需冻结](默认为N):")))
(setq xz (strcase (getstring "合并过程中是否保存合并文件[是(Y)/否(N)](默认为N):")))
(setq tk (strcase (getstring "合并结果是否保存为图块[是(Y)/否(N)](默认为N):")))
(if(/= tc "N") ;生成需要冻结的图层的表
(setq tc (line-list tc) )
(setq tc '())
)
(if erg
(progn
(setq lst (line-list erg));按空格转换成表----
;由于一个文件时路径之间与文件名没有空格，在此加上空格:(d:\\1.dwg)-->(d:\\ 1.dwg)------
(if (= (length lst) 1)
(progn
(setq l(car lst))
(repeat(strlen l)(if (=(substr l (setq i (+ i 1)) 1)"\\") (setq jj i)) )
(setqlj (substrl 1 jj));得到路径
(setqmz (substr l (+ jj 1)));得到文件名（含扩展名）
(setq str-lj (strcat lj " " mz))(setq lst (line-list str-lj))
)
);end if
;创建更改后文件名列表lst-gm--------
(setq n 1 lst-gmlst)
(repeat (- (length lst-gm) 1)
(setq lst-gm (SUBST (strcat "xhb-合并ing" (nth n lst-gm)) (nth n lst-gm) lst-gm) )
(setq n (+ n 1))
);end repeat
(setq bclj (strcat (nth 0 lst) "合并结果.dwg"));获取保存路径
(setq lst (lj-lst lst))(setq lst-gm (lj-lst lst-gm));调用函数，生成更改文件名前后的各文件的完整文件路径、文件名的列表
(sub-filenamelst lst-gm);文件名替代
(setq ii 0)
(pross 0 (length lst-gm));显示进度
(foreach lj lst-gm;插入、分解、显示进度
(command "insert" lj "0,0" "1" "1" "0" "" "" "" )
(if(/= tk "Y") ;炸开
(progn(setq ent (entlast)) (command "explode" ent "")(setq ent nil) (gc))
)
(setq ii (+ ii 1))
(if (= ii 1)(foreach tc-one tc (command "layer" "s" "0""F" tc-one "")));在插入一幅图时冻结图层
;;保存：如果原文件已经有保存路径，则直接保存，否则，按指定路径另存为。如果另存为路径上已有相同的文件名，则覆盖该文件
(COND
((= xz "Y")
(if (= ii (or (setq s (/ (length lst-gm) 2))(setq ss (+(/ (length lst-gm) 4) s)) (+(/ (length lst-gm) 8) ss)(length lst-gm) ))
(progn(repeat 3 (command "purge" "A" "*" "N")) (command "qsave"bclj "y" ""))
))
(T (if (= ii (length lst-gm)) (progn(repeat 3 (command "purge" "A" "*" "N")) (command "qsave"bclj "y" "")) ) )
)(gc);end cond
(pross ii (length lst-gm));显示进度
);end foreach
);end progn
)
(sub-filename lst-gm lst);文件名还原
(command "zoom" "e" "")
(setvar "OSMODE" OS_OLD)
( PRINC)
)
(defun getfiles (/ x erg);获取文件的路径和文件名一个文件返回后路径和文件名之间无空格分开，格式“d:\\1.dwg”.两个以上文件返回后路径和文件名之间有空格分开格式“d:\\ 1.dwg 2.dwg ...”
(vl-registry-write
"HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905"
""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
;;(startapp "RegSvr32" "C:\\Windows\\SysWOW64\\comdlg32.ocx")
(if (setq x (vlax-create-object "MSComDlg.CommonDialog"))
(progn (vlax-put-property x "DialogTitle" "选择图形文件")
(vlax-put-property x "Filename" "*.dwg")
(vlax-put-property x "Filter" "*.dwg")
(vlax-put-property x "MaxFileSize" 10000)
(vlax-put-property x "Flags" 512)
(vlax-put-property x "Action" 1);_ showopen-dialog
(setq erg (vlax-get-property x "Filename"))
)
nil
)
)
(defunline-list(str);将传入的一行数据以空格和换行符、结束符为界，转换为表中的元素,如传入：12ne34nw45 光面 1 -1 运行后传回（12ne34nw45 光面 1 -1）
(if str
(progn
(setq str (strcat str "\n"))
(setq len (strlen str))
(setq l '()k 1 s-str ""p nil)
(while (<= k len)
(setq one (substr str k 1))
(if (or (= one (chr 9)) (= one "") (= one ",")(= one " ") (= one "\n"))
(if p
(progn
(if (= (type (read s-str)) 'SYM)
(setq l(cons s-str l))
(setq l (cons (read s-str) l))
)
(setq s-str "" p nil)
);end progn
) ;end if p
(setq s-str (strcat s-str one)p t)
);end if
(setq k (1+ k))
);end while
(reverse l)
);progn end
)) ;if and function end
;生成各文件的完整文件路径、文件名的列表
(defun lj-lst(lst)
(if (/= (length lst) 1)
(progn
(setq i 1)
(repeat (- (length lst) 1)
(setq lst (SUBST (strcat (nth 0 lst) (nth i lst)) (nth i lst) lst) )
(setq i (+ i 1))
);end repeat
(setq lst (cdr lst))
);end progn
)
)
;文件名更改函数
(defun sub-filename(lst lst-gm)
(setq g 0)
(repeat (length lst)
(vl-file-rename (nth g lst) (nth g lst-gm) )
(setq g (+ g 1))
)
)
(defun pross(k m);显示进度
;(grtext -2 (strcat "已完成"(rtos (/ (* 100.0 k) m) 2 0)"%..."))
(grtext -2 (strcat "已完成"(rtos k) "张" "...," "共" (rtos m) "张。 ))
) 原来的32位系统上能运行，现在的64位上不能运行了，有没什么办法呢？ com控件不支持64位？ 去下载这个 comdlg32.ocx 32位64位通用的试试！替换c:\Windows\SysWOW64\comdlg32.ocx
regsvr32 c:\Windows\SysWOW64\comdlg32.ocx
页:
[1]