|
|
下面這個程序是我公司里運用的小程序. 在命令提示行輸入運行很正常. 但是我要把這段代碼放到ACAD.LSP加載並運行時會彈出 HELP 幫助界面的. 不知是什麼回事. 望知道的大俠指導指導.
;-----------------------------------------------------------------------------------
;程序編寫: BDYCAD
;程序功能: 插入鞋圖在指定的位置
;編寫時間: 2003-11-13
;使用涵數: (insert-image-shoe)
(defun insert-image-shoe(/ )
(seterr)
(setq os (getvar "osmode"))
(setvar "osmode" 0)(setvar "cmdecho" 0)
(setq layer (getvar "clayer"))
(setvar "clayer" "AID")
(setq a (strcat (substr (getvar "dwgname") 1 (-(strlen (getvar "dwgname")) 4)) ".jpg"))
(if (findfile a)(insert-image-shoe-ok))
(setvar "clayer" layer)
(princ))
(defun insert-image-shoe-ok(/ imans adata b eb bdata p1 pt1 p2 pt2 p3 pt3 pt4 xd yd pt5 el apt1 apt2 apt3 apt4)
(command "._imageframe" "ON")
(IF(= (GETVAR "QAFLAGS") 0) (setvar "QAFLAGS" 1))
(command ".image" "a" a " 0,0" "" "" "" )
(setq imans(entlast))
(setq adata (entget imans))
(setq b (cdr (assoc 10 adata)))
(command ".explode" imans "")
(command ".pedit" (entlast) "" "J" "all" "" "")
(setq eb (entlast))
(setq bdata (entget eb))
(setq p1 (assoc 10 bdata))(setq pt1 (cdr p1))(SETQ bdata (vl-remove p1 bdata))
(setq p2 (assoc 10 bdata))(setq pt2 (cdr p2))(SETQ bdataf (vl-remove p2 bdata))
(setq p3 (assoc 10 bdata))(setq pt3 (cdr p3))(SETQ bdata (vl-remove p3 bdata))
(setq pt4 (cdr(assoc 10 bdata)))
(SETQ xd (distance pt1 pt2))
(setq yd (distance pt2 pt3))
(entdel eb)
(command ".image" "D" (strcat (substr (getvar "dwgname") 1 (-(strlen (getvar "dwgname")) 4)) ) );" 0,0" "" "" "" )
;;; (ENTMAKE adata)
(command ".image" "a" a " 0,0" "" "" "" )
(command ".scale" (entlast) "" b "r" xd 330)
;(setq pt5 (list 330 198));(/ (* 330 yd ) xd)))
(setq el (entlast))
(image-inster-point)
(command ".move" el "" "330,198" (list (- (car apt3)1.0)(- (cadr apt3)1.0)))
;;; (command ".chprop" el "" "la" "AID" "" )
(command "._imageframe" "OFF")
(setvar "osmode" os)(setvar "cmdecho" 1)
(IF(= (GETVAR "QAFLAGS") 1) (setvar "QAFLAGS" 0))
(geterr)
(princ))
(defun image-inster-point(/ rectangle-color6 n pdata ap1 ap2 ap3 ap4 apt1 apt2 apt4)
(setq rectangle-color6 (ssget "x" '((8 . "AID")(0 . "LWPOLYLINE") (62 . 6))))
(setq n(sslength rectangle-color6))
(setq pdata (entget (ssname rectangle-color6 (- n 1))))
(setq ap1 (assoc 10 pdata))(setq apt1 (cdr ap1))(SETQ pdata (vl-remove ap1 pdata))
(setq ap2 (assoc 10 pdata))(setq apt2 (cdr ap2))(SETQ pdata (vl-remove ap2 pdata))
(setq ap3 (assoc 10 pdata))(setq apt3 (cdr ap3))(SETQ pdata (vl-remove ap3 pdata))
(setq ap4 (assoc 10 pdata))(setq apt4 (cdr ap4))
(princ))這個程序有一個怪問題,
xpckxrbcscu.JPG
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
