lisp 内预览DWG 图形----老大难？考验高手！

daziran

背景：
  我完全用lisp作了制图题库管理软件（写了不少比特呀）。效果相当不错。
  13版时，用了一个网上下载的专用函数览图，但是14版以后就再也找不到了。
  我的软件也就完完了！

问题：在lisp编写的DCL内的某一个区域显示DWG 图形。

求援：请各位帮忙解决。 我不清楚 LISP和VB以及ActiveX 之间的关系。
      比如这里提供的DwgThumbnail图形缩略图预览控件  或者imageview.zip 可以用吗？
如果真解决不了，我就死心了！

前生

(DEFUN COOKD()
(PROGN
  (SETQ LP3A 1)
  (WHILE LP3A
   (SETQ RFN (GETFILED "CHOOSE DRAWING TO LOOK AT" "" "DWG" 0))
   (IF (= RFN NIL)
    (PROGN
     (PROMPT "\nNO FILE SELECTED ")
     (SETQ LP3A NIL)
    );END PROGN
    (PROGN
     (SETQ LP3A NIL)
     (SETQ LDSG "GO")
     (SETQ RFNL (STRLEN RFN))
     (SETQ RSFN (SUBSTR RFN 1 (- RFNL 4)))
   ));END PROGN/IF LDS
  );END LP3A
);END PROGN
(IF (= LDSG "GO")
  (PROGN
   (COMMAND "_UNDO" "M")
   (SETQ CMDP2 (GETVAR "CMDECHO"))
   (SETVAR "CMDECHO" 0)
   (SETQ LDSG NIL)
   (PROMPT "\n*WATSON*: LOOKING AT ")
   (PRINC RFN)
   (PROMPT " ...")  
;   (COMMAND "_LAYER" "M" "WatsonX" "S" "WatsonX" "OFF" "*" "N" "")
;   (SETQ WLES (SSGET "X" '((8 . "WatsonX"))))
;   (IF (/= WLES NIL) (COMMAND "_ERASE" WLES ""))
;   (SETQ VCTR (GETVAR "VIEWCTR"))
   (SETQ VCTR (LIST 0.0 0.0 0.0))
   (COMMAND "_PLAN" "W")
   (COMMAND "_UCS" "D" "IVC2")
   (COMMAND "_UCS" "O" VCTR)
   (COMMAND "_UCS" "S" "IVC2")
   (SETVAR "ATTREQ" 0)
   (COMMAND "_INSERT" RFN)
   (COMMAND VCTR)
   (COMMAND "X" )
   (COMMAND "1")
   (COMMAND "" "" "")
   (SETVAR "ATTREQ" 1)
   (COMMAND "_ZOOM" "E")
   (PRINC)
   (PROMPT "\nAdjust view points then enter their descriptions, exit when done. ")
   (SETQ DDX 1)
   (WHILE DDX
    (SETQ LP3B 1)
    (WHILE LP3B         
     (INITGET "Z z O o V v D d T t B b L l R r F f K k SW sw SE se NE ne NW nw E n P p X x")
     (SETQ DIKW (GETKWORD "\nZoom/Origin/Vpoint/Ddvpoint/Top/Bottom/Left/Right/Front/bacK/SW/SE/NE/NW/Enter description/Pick description/eXit: "))
     (IF (OR (= DIKW "Z") (= DIKW "z"))
      (PROGN
       (INITGET "A a E e P p S s W w R r")
       (SETQ ZKW (GETKWORD "\nAll/Extents/Previous/Scale(X/XP)/Window/<Realtime>: "))
       (IF (OR (OR (= ZKW "R") (= ZKW "r")) (= ZKW NIL)) (COMMAND "_ZOOM" ""))
       (IF (OR (= ZKW "A") (= ZKW "a")) (COMMAND "_ZOOM" "A"))
       (IF (OR (= ZKW "E") (= ZKW "e")) (COMMAND "_ZOOM" "E"))
       (IF (OR (= ZKW "") (= ZKW "p")) (COMMAND "_ZOOM" ""))
       (IF (OR (= ZKW "S") (= ZKW "s")) (PROGN (COMMAND "_ZOOM") (SETVAR "CMDECHO" 1) (COMMAND "S" PAUSE) (SETVAR "CMDECHO" 0)))
       (IF (OR (= ZKW "W") (= ZKW "w")) (PROGN (COMMAND "_ZOOM") (SETVAR "CMDECHO" 1) (COMMAND "W" PAUSE PAUSE) (SETVAR "CMDECHO" 0)))
     ));END PROGN/IF DIKW
     (IF (OR (= DIKW "O") (= DIKW "o")) (PROGN (COMMAND "_UCS" ) (SETVAR "CMDECHO" 1) (COMMAND "O" PAUSE)(SETVAR "CMDECHO" 0)))
     (IF (OR (= DIKW "V") (= DIKW "v")) (PROGN (SETVAR "CMDECHO" 1) (COMMAND "_VPOINT" "" PAUSE) (SETVAR "CMDECHO" 0)))
     (IF (OR (= DIKW "D") (= DIKW "d")) (C:DDVPOINT))
     (IF (OR (= DIKW "T") (= DIKW "t")) (COMMAND "_VPOINT" "0,0,1"))
     (IF (OR (= DIKW "B") (= DIKW "b")) (COMMAND "_VPOINT" "0,0,-1"))
     (IF (OR (= DIKW "L") (= DIKW "l")) (COMMAND "_VPOINT" "-1,0,0"))
     (IF (OR (= DIKW "R") (= DIKW "r")) (COMMAND "_VPOINT" "1,0,0"))
     (IF (OR (= DIKW "F") (= DIKW "f")) (COMMAND "_VPOINT" "0,-1,0"))
     (IF (OR (= DIKW "K") (= DIKW "k")) (COMMAND "_VPOINT" "0,1,0"))
     (IF (OR (= DIKW "SW") (= DIKW "sw")) (COMMAND "_VPOINT" "-1,-1,1"))
     (IF (OR (= DIKW "SE") (= DIKW "se")) (COMMAND "_VPOINT" "1,-1,1"))
     (IF (OR (= DIKW "NE") (= DIKW "ne")) (COMMAND "_VPOINT" "1,1,1"))
     (IF (OR (= DIKW "NW") (= DIKW "nw")) (COMMAND "_VPOINT" "-1,1,1"))
     (IF (OR (= DIKW "E") (= DIKW "e")) (PROGN (SETQ DEM NIL) (SETQ LP3B NIL)))
     (IF (OR (= DIKW "") (= DIKW "p")) (PROGN (SETQ DEM 1) (SETQ LP3B NIL)))
     (IF (OR (= DIKW "X") (= DIKW "x")) (PROGN (SETQ LP3B NIL) (SETQ DDX NIL)))
    );END LP3B   
    (IF (= DDX 1)
     (PROGN
      (COMMAND "_UCS" "R" "IVC2")
      (SETQ VWDIR (GETVAR "VIEWDIR"))
      (SETQ XVWDIR (RTOS (CAR VWDIR) 2 2))
      (SETQ YVWDIR (RTOS (CAR (CDR VWDIR)) 2 2))
      (SETQ ZVWDIR (RTOS (CAR (CDR (CDR VWDIR))) 2 2))
      (SETQ VWDIRS (STRCAT XVWDIR "," YVWDIR  "," ZVWDIR))
      (SETQ VWSZ2 (GETVAR "VIEWSIZE"))
      (SETQ VWSZ2S (RTOS VWSZ2 2 2))
      (SETQ VWCTR (GETVAR "VIEWCTR"))
      (SETQ XVWCTR (RTOS (CAR VWCTR) 2 2))
      (SETQ YVWCTR (RTOS (CAR (CDR VWCTR)) 2 2))
      (SETQ ZVWCTR (RTOS (CAR (CDR (CDR VWCTR))) 2 2))
      (SETQ VWCTRS (STRCAT XVWCTR "," YVWCTR  "," ZVWCTR))
      (SETQ FS "")
      (SETQ FSS 0)
      (IF (/= DEM 1)
       (PROGN
        (PROMPT"\nEnter verbal description: ")
        (SETQ FS (READ-LINE))
       );END PROGN DEM
       (PROGN
        (SETQ LP3C 1)
        (WHILE LP3C
         (PROMPT "\nPick text or attribute object for verbal description. ")
         (PROMPT "\n")
         (SETQ DPNE (NENTSEL))
         (IF (/= DPNE NIL)
          (PROGN
           (SETQ DP (CAR DPNE))
           (SETQ DPL (ENTGET DP))
           (SETQ DPLE (CDR (ASSOC 0 DPL)))
           (SETQ DPLT (CDR (ASSOC 1 DPL)))
           (IF (OR (= DPLE "MTEXT") (= DPLE "TEXT") (= DPLE "ATTRIB"))
            (PROGN
             (SETQ FS (STRCAT FS " " DPLT))
             (PROMPT "\n1 found, value = ")
             (PRINC DPLT)
             (SETQ FSS 1)
            );END PROGN DPLE
            (PROMPT "OBJECT SELECTED NOT A TEXT OR ATTRIBUTE ")      
           );END IF DPLE
          );END PROGN DPNE
          (PROGN         
           (IF (= FSS 1)
            (PROGN
             (SETQ LP3C NIL)
            );END PROGN FSS
            (PROGN
             (PROMPT "\nNO TEXT OR ATTRIBUTE OBJECTS FOUND ")
             (SETQ FS NIL)
             (SETQ LP3C NIL)
           ));END PROGN/IF FSS
         ));END PROGN/IF DPNE
        );END LP3C
      ));END PROGN/IF DEM
      (IF (/= FS NIL)
       (PROGN
        (SETQ IS FS)
        (SETQ RDR (OPEN (STRCAT RSFN ".wdd") "r"))
        (IF (= RDR NIL) (PROGN (SETQ RDR (OPEN (STRCAT RSFN ".wdd") "a")) (WRITE-LINE RFN RDR) (CLOSE RDR) (SETQ RDR (OPEN (STRCAT RSFN ".wdd") "r"))))
        (SETQ RDL NIL)
        (SETQ RN 1)
        (SETQ LP4 1)
        (WHILE LP4
         (SETQ RDS (READ-LINE RDR))
         (IF (/= RDS NIL) (PROGN (SETQ RDL (APPEND RDL (LIST RDS))) (SETQ RN (+ RN 1))) (SETQ LP4 NIL))
        );END LP4
        (CLOSE RDR)
        (SETQ PS IS)
        (SETQ SSS 1)
        (SETQ LP5 1)
        (WHILE LP5
         (SETQ PSL (STRLEN PS))
         (SETQ SS (SUBSTR PS SSS 1))
         (SETQ SSD (ASCII SS))
         (IF (/= (OR (AND (> SSD 64) (< SSD 91)) (AND (> SSD 96) (< SSD 123)) (AND (> SSD 47) (< SSD 58))) T)
          (PROGN
           (SETQ WD (SUBSTR PS 1 (- SSS 1)))
            (SETQ WD (STRCASE WD 1))
           ;(PRINC WD)
           (SETQ WMT NIL)
           (SETQ PRDL RDL)
           (SETQ LP6 1)
           (WHILE LP6
            (SETQ RDS (CAR PRDL))
            (SETQ WMT (WCMATCH RDS (STRCAT WD "|" "*")))
            (IF (/= WMT NIL) (PROGN (SETQ WMT RDS) (SETQ LP6 NIL)) (SETQ PRDL (CDR PRDL)))
            (IF (= PRDL NIL) (SETQ LP6 NIL))
           );END LP6
           ;(PRINT WMT)
           (IF (/= WMT NIL)
            (PROGN
             (SETQ NWMT (STRCAT WMT "|" VWDIRS "/" VWSZ2S "/" VWCTRS "<"))
             (SETQ RDL (SUBST NWMT WMT RDL))
            );END PROGN
            (PROGN
             (IF (/= WD "")
              (SETQ RDL (APPEND RDL (LIST (STRCAT WD "|" VWDIRS "/" VWSZ2S "/" VWCTRS "<"))))
            ));END IF/PROGN
           );END IF      
           (SETQ PS (SUBSTR PS (+ SSS 1) ))
           (SETQ SSS 1)
          );END PROGN
          (SETQ SSS (+ SSS 1))
         ); END IF SS
         (IF (= PSL 0) (SETQ LP5 NIL))
        );END WHILE LP5
        (SETQ RDR (OPEN (STRCAT RSFN ".wdd") "w"))
;        (SETQ RDL (ACAD_STRLSORT RDL))
        (SETQ PRDL RDL)
        (SETQ LP7 1)
        (WHILE LP7
         (SETQ RDS (CAR PRDL))
         (WRITE-LINE RDS RDR)
         (SETQ PRDL (CDR PRDL))
         (IF (= PRDL NIL) (SETQ LP7 NIL))
        );END WHILE LP7
        (CLOSE RDR)
       );END PROGN FS
       (SETQ LP3 NIL)
      );END IF FS      
      (SETQ WFR (OPEN "C:\\Wat\\FD.wfd" "r"))
      (IF (= WFR NIL) (PROGN (SETQ WFR (OPEN "C:\\Wat\\FD.wfd" "a"))  (CLOSE WFR) (SETQ WFR (OPEN "C:\\Wat\\FD.wfd" "r"))))
      (SETQ FRST NIL)
      (SETQ LP8 1)
      (WHILE LP8
       (SETQ FRS (READ-LINE WFR))
       (IF (= FRS (STRCAT RSFN ".wdd")) (SETQ FRST 1))
       (IF (= FRS NIL) (SETQ LP8 NIL))
      );END LP8
      (CLOSE WFR)
      (IF (/= FRST 1)
       (PROGN
        (SETQ WFR (OPEN "C:\\Wat\\FD.wfd" "a"))
        (WRITE-LINE (STRCAT RSFN ".wdd") WFR)
        (CLOSE WFR)
      ));END PROGN/IF FRST  
    ));END PROGN/IF DXX  
   );END DXX
   (COMMAND "_UNDO" "E")
   (COMMAND "_UNDO" "B")  
   (SETVAR "CMDECHO" CMDP2)
));END PROGN/IF LDSG
(PRINC)
);END LOOKD

daziran

lgh930

晓东CAD上有，我已成功在lisp编写的DCL内的某一个区域显示DWG 图形

daziran