lisp 内预览DWG 图形----老大难？考验高手！
背景：我完全用lisp作了制图题库管理软件（写了不少比特呀）。效果相当不错。
13版时，用了一个网上下载的专用函数览图，但是14版以后就再也找不到了。
我的软件也就完完了！
问题：在lisp编写的DCL内的某一个区域显示DWG 图形。
求援：请各位帮忙解决。 我不清楚 LISP和VB以及ActiveX 之间的关系。
比如这里提供的DwgThumbnail图形缩略图预览控件或者imageview.zip 可以用吗？
如果真解决不了，我就死心了！
看一下。我找到的，不知道有用没有.
(DEFUN C:LOOKD()(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 "P") (= ZKW "p")) (COMMAND "_ZOOM" "P"))
(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 "P") (= 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
这个程序是调入一个图形，然后“看来看去”，再删除。 前生别放弃帮助呀。
在lisp编写的DCL内的某一个区域显示DWG 图形
晓东CAD上有，我已成功在lisp编写的DCL内的某一个区域显示DWG 图形谢谢 lgh930， 说具体点，帮人帮到底！
页:
[1]