设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 请问以下这段函数在lisp程序中调用时，有的电脑能调用， ...
返回列表 发新帖
查看: 1402|回复: 5

[提问] 请问以下这段函数在lisp程序中调用时，有的电脑能调用，有的不能、选择文件对话框...

[复制链接]
xhbcdut
发表于 2017-10-11 12:10 | 显示全部楼层 |阅读模式
1明经币
请问以下这段函数在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  
)
)

回复

使用道具 举报

xhbcdut
 楼主| 发表于 2017-10-11 12:42 | 显示全部楼层
本帖最后由 ZZXXQQ 于 2017-10-11 14:45 编辑

完整的程序如下，批量合并cad图程序
  1. (defun c:hb()
  2. (setq OS_OLD (getvar "OSMODE"))
  3. (setvar "OSMODE" 0)
  4. (setvar "CMDECHO" 0)
  5. (vl-load-com)
  6.    (setq erg (getfiles));选择图形文件，传回文件路径
  7.    (setq tc (strcase (getstring "指定需冻结的图层名[如(9110,8110,8300),(N)表不需冻结](默认为N):")))
  8.    (setq xz (strcase (getstring "合并过程中是否保存合并文件[是(Y)/否(N)](默认为N):")))
  9.    (setq tk (strcase (getstring "合并结果是否保存为图块[是(Y)/否(N)](默认为N):")))
  10.    (if  (/= tc "N") ;生成需要冻结的图层的表
  11.         (setq tc (line-list tc) )
  12.         (setq tc '())   
  13.    )
  14.    
  15.      (if erg
  16.      (progn
  17.         (setq lst (line-list erg));按空格转换成表----
  18.         ;由于一个文件时路径之间与文件名没有空格，在此加上空格d:\\1.dwg)-->(d:\\ 1.dwg)------
  19.         (if (= (length lst) 1)
  20.            (progn
  21.              (setq l  (car lst))
  22.              (repeat  (strlen l)  (if (=(substr l (setq i (+ i 1)) 1)  "\\")   (setq jj i))   )
  23.               (setq  lj (substr  l 1 jj))  ;得到路径
  24.               (setq  mz (substr l (+ jj 1)));得到文件名（含扩展名）
  25.               (setq str-lj (strcat lj " " mz))  (setq lst (line-list str-lj))   
  26.            )
  27.         );end if
  28.         
  29.         ;创建更改后文件名列表lst-gm--------
  30.         (setq n 1    lst-gm  lst)
  31.         (repeat (- (length lst-gm) 1)
  32.                (setq lst-gm (SUBST (strcat "xhb-合并ing" (nth n lst-gm))    (nth n lst-gm)   lst-gm) )
  33.                (setq n (+ n 1))
  34.         );end repeat        
  35.         
  36.         (setq bclj (strcat (nth 0 lst) "合并结果.dwg"));获取保存路径
  37.         (setq lst (lj-lst lst))  (setq lst-gm (lj-lst lst-gm))  ;调用函数，生成更改文件名前后的各文件的完整文件路径、文件名的列表
  38.         
  39.         (sub-filename  lst lst-gm)  ;文件名替代
  40.         
  41.         (setq ii 0)
  42.         (pross 0 (length lst-gm));显示进度
  43.         (foreach lj lst-gm  ;插入、分解、显示进度
  44.            (command "insert" lj "0,0" "1" "1" "0" "" "" "" )
  45.            (if  (/= tk "Y")   ;炸开
  46.               (progn  (setq ent (entlast)) (command "explode" ent "")  (setq ent nil) (gc))
  47.            )
  48.            (setq ii (+ ii 1))
  49.            (if (= ii 1)(foreach tc-one tc (command "layer" "s" "0"  "F" tc-one "")));在插入一幅图时冻结图层
  50.             ;;保存：如果原文件已经有保存路径，则直接保存，否则，按指定路径另存为。如果另存为路径上已有相同的文件名，则覆盖该文件
  51.            (COND
  52.              ((= xz "Y")
  53.                (if (= ii (or (setq s (/ (length lst-gm) 2))  (setq ss (+(/ (length lst-gm) 4) s))   (+(/ (length lst-gm) 8) ss)  (length lst-gm) ))  
  54.                    (progn  (repeat 3 (command "purge" "A" "*" "N")) (command "qsave"  bclj "y" ""))
  55.              ))
  56.              (T   (if (= ii (length lst-gm))   (progn  (repeat 3 (command "purge" "A" "*" "N")) (command "qsave"  bclj "y" "")) ) )
  57.            )  (gc);end cond
  58.            (pross ii (length lst-gm));显示进度
  59.         );end foreach
  60.      );end progn
  61.    )
  62. (sub-filename lst-gm lst)  ;文件名还原
  63. (command "zoom" "e" "")   
  64. (setvar "OSMODE" OS_OLD)
  65. ( PRINC)
  66. )

  68. (defun getfiles (/ x erg)  ;获取文件的路径和文件名  一个文件返回后路径和文件名之间无空格分开，格式“d:\\1.dwg”.两个以上文件返回后路径和文件名之间有空格分开格式“d:\\ 1.dwg 2.dwg ...”
  69. (vl-registry-write
  70. "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905"
  71. ""
  72. "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
  73. )
  74. ;;(startapp "RegSvr32" "C:\\Windows\\SysWOW64\\comdlg32.ocx")
  75. (if (setq x (vlax-create-object "MSComDlg.CommonDialog"))   
  76. (progn (vlax-put-property x "DialogTitle" "选择图形文件")   
  77.   (vlax-put-property x "Filename" "*.dwg")  
  78.   (vlax-put-property x "Filter" "*.dwg")   
  79.   (vlax-put-property x "MaxFileSize" 10000)  
  80.   (vlax-put-property x "Flags" 512)  
  81.   (vlax-put-property x "Action" 1)  ;_ showopen-dialog     
  82.   (setq erg (vlax-get-property x "Filename"))
  83. )
  84. nil  
  85. )
  86. )


  89. (defun  line-list(str)  ;将传入的一行数据以空格和换行符、结束符为界，转换为表中的元素,如传入：12  ne34nw45 光面 1 -1 运行后传回（12  ne34nw45 光面 1 -1）
  90.   (if str
  91.    (progn
  92.       (setq str (strcat str "\n"))
  93.       (setq len (strlen str))
  94.       (setq l '()  k 1 s-str ""  p nil)
  95.       (while (<= k len)
  96.              (setq one (substr str k 1))
  97.              (if (or (= one (chr 9)) (= one "") (= one ",")(= one " ") (= one "\n"))
  98.                (if p
  99.                  (progn
  100.                        (if (= (type (read s-str)) 'SYM)
  101.                            (setq l(cons s-str l))
  102.                            (setq l (cons (read s-str) l))
  103.                        )
  104.                        (setq s-str "" p nil)
  105.                  );end progn                 
  106.                ) ;end if p
  107.                (setq s-str (strcat s-str one)  p t)
  108.              );end if  
  109.              (setq k (1+ k))            
  110.       );end while
  111.       (reverse l)
  112.    );progn end
  113. )) ;if and function end

  115. ;生成各文件的完整文件路径、文件名的列表        
  116. (defun lj-lst(lst)
  117.         (if (/= (length lst) 1)
  118.            (progn
  119.              (setq i 1)
  120.              (repeat (- (length lst) 1)
  121.                (setq lst (SUBST (strcat (nth 0 lst) (nth i lst))    (nth i lst)   lst) )
  122.                (setq i (+ i 1))
  123.              );end repeat
  124.              (setq lst (cdr lst))
  125.            );end progn
  126.          )
  127. )
  128. ;文件名更改函数
  129. (defun sub-filename(lst lst-gm)
  130.   (setq g 0)
  131.   (repeat (length lst)
  132.    (vl-file-rename (nth g lst) (nth g lst-gm) )
  133.    (setq g (+ g 1))
  134.   )
  135. )


  138. (defun pross(k m)  ;显示进度
  139. ;(grtext -2 (strcat "已完成"  (rtos (/ (* 100.0 k) m) 2 0)  "%..."))
  140. (grtext -2 (strcat "已完成"  (rtos k) "张" "...," "共" (rtos m) "张。 ))
  141. )

点评

ZZXXQQ
倒数第一行行未少了双引号  发表于 2017-10-11 15:20
回复

使用道具 举报

xhbcdut
 楼主| 发表于 2017-10-11 14:44 | 显示全部楼层
原来的32位系统上能运行，现在的64位上不能运行了，有没什么办法呢？
回复

使用道具 举报

vectra
发表于 2017-10-11 16:13 来自手机 | 显示全部楼层
com控件不支持64位？
回复

使用道具 举报

xiaolong1487
发表于 2017-10-27 16:17 | 显示全部楼层
去下载这个 comdlg32.ocx 32位64位通用的试试！替换c:\Windows\SysWOW64\comdlg32.ocx
regsvr32 c:\Windows\SysWOW64\comdlg32.ocx

回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-4-16 16:28 , Processed in 0.338377 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表