wesleyaqua Posted April 3, 2014 Author Posted April 3, 2014 wesleyaqua, I know about the bug, hence my not completely OK. What we need to do is to switch page when we select in the listbox. Not too difficult. We also need to set condition right at beginning of routine. Looking into it as we speak. Will revert to you. (action_tile "blocknameslist" "(setq idx (+ (atoi $value) 1)) (if SlideRef$ (mode_tile SlideRef$ 4)) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t) (mode_tile SlideRef$ 4)") (action_tile (strcat "sld" (itoa Rep#)) "(setq idx (+ (- (atoi (vl-string-subst \"\" \"sld\" $key)) 1) (* Pg_No# 20))) (if SlideRef$ (mode_tile SlideRef$ 4)) (mode_tile $key 4) (set_tile \"blocknameslist\" (itoa idx)) (setq SlideRef$ $key Pick t)") try this last one ymg okay i tryed your last post and it works as followed. i take next page but the list box only the 20 first will highlight again. so they are not really linked with the right image at the second page (i also changed the dcl now i have dwg_blks and dwg_blks1 so if you need to make chages to the part of userlib you can) Quote
ymg3 Posted April 3, 2014 Posted April 3, 2014 (edited) Try with this: ;----------------------------------------------------------------------------- ; Load DCL dialog: Dwg_Blks in Blk_Lib.dcl ;----------------------------------------------------------------------------- (princ "\nSelect a block or option: ")(princ) (setq Dcl_Id% (load_dialog "Blk_Lib.dcl")) (while (/= Option# 1) (new_dialog "Dwg_Blks" Dcl_Id%) (start_list "blocknameslist") (mapcar 'add_list blklist@) (end_list) (set_tile "title" (strcat " " LibTitle$ " Library " (itoa (+ Pg_No# 1)) " of " (itoa (+ No_Pages# 1))) ) (if (= Pg_No# No_Pages#) (mode_tile "next" 1) (mode_tile "next" 0) ) (if (= Pg_No# 0) (mode_tile "previous" 1) (mode_tile "previous" 0) ) (if (> BlockLen# 19) (setq No_Blks# 20) (setq No_Blks# BlockLen#) ) (action_tile "next" "(done_dialog 4)") (action_tile "previous" "(done_dialog 3)") (action_tile "cancel" "(done_dialog 2)") (action_tile "blocknameslist" "(setq idx (+ (atoi $value) 1)) (if SlideRef$ (mode_tile SlideRef$ 4)) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t) (cond ((> idx (+ (* Pg_No# 20) 20)) (done_dialog 4)) ((< idx (* Pg_No# 20)) (done_dialog 3)) (t (mode_tile SlideRef$ 4)) )") (setq Rep# 1) (repeat (fix No_Blks#) (setq ImageName$ (nth (+ (* Pg_No# 20) (- Rep# 1)) BlkList@)) (action_tile (strcat "sld" (itoa Rep#)) "(setq idx (+ (- (atoi (vl-string-subst \"\" \"sld\" $key)) 1) (* Pg_No# 20))) (if SlideRef$ (mode_tile SlideRef$ 4)) (mode_tile $key 4) (set_tile \"blocknameslist\" (itoa idx)) (setq SlideRef$ $key Pick t)") (start_image (strcat "sld" (itoa Rep#))) (slide_image 0 0 (dimx_tile (strcat "sld" (itoa Rep#))) (dimy_tile (strcat "sld" (itoa Rep#))) (strcat DefPath$ ImageName$ ".sld") ) (end_image) (set_tile (strcat "sld" (itoa Rep#) "text") ImageName$) (setq Rep# (1+ Rep#)) ) (if SlideRef$ (progn (print slideref$) (setq idx (- (atoi (vl-string-subst "" "sld" SlideRef$)) (* Pg_No# 20))) (print idx) (mode_tile (strcat "sld" (itoa idx)) 4) (set_tile "blocknameslist" (itoa (+ idx (* Pg_No# 20) -1))) ) (progn (setq idx (+ (* Pg_No# 20) 1)) (mode_tile "sld1" 4) (setq SlideRef$ (strcat "sld" (itoa idx))) (set_tile "blocknameslist" SlideRef$) ) ) (setq Option# (start_dialog)) (if (= Option# 4);next (setq Pg_No# (1+ Pg_No#) BlockLen# (- BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 3);previous (setq Pg_No# (- Pg_No# 1) BlockLen# (+ BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 2);cancel (setq Option# 1 SlideRef$ nil ) ) ) (unload_dialog Dcl_Id%) There is still a problem when we use previous and next, probably need some code on the action_tile there. Edited April 3, 2014 by ymg3 Quote
ymg3 Posted April 4, 2014 Posted April 4, 2014 wesleyaqua, I believe I got it nailed! Try this latest: ;----------------------------------------------------------------------------- ; Load DCL dialog: Dwg_Blks in Blk_Lib.dcl ;----------------------------------------------------------------------------- (princ "\nSelect a block or option: ")(princ) (setq Dcl_Id% (load_dialog "Blk_Lib.dcl")) (while (/= Option# 1) (new_dialog "Dwg_Blks" Dcl_Id%) (start_list "blocknameslist") (mapcar 'add_list blklist@) (end_list) (set_tile "title" (strcat " " LibTitle$ " Library " (itoa (+ Pg_No# 1)) " of " (itoa (+ No_Pages# 1))) ) (if (= Pg_No# No_Pages#) (mode_tile "next" 1) (mode_tile "next" 0) ) (if (= Pg_No# 0) (mode_tile "previous" 1) (mode_tile "previous" 0) ) (if (> BlockLen# 19) (setq No_Blks# 20) (setq No_Blks# BlockLen#) ) (action_tile "next" "(setq Slideref$ nil) (done_dialog 4)") (action_tile "previous" "(setq Slideref$ nil) (done_dialog 3)") (action_tile "cancel" "(done_dialog 2)") (action_tile "select" "(done_dialog 1)") (action_tile "blocknameslist" "(setq idx (+ (atoi $value) 1)) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t) (cond ((> idx (+ (* Pg_No# 20) 20)) (done_dialog 4)) ((< idx (* Pg_No# 20)) (done_dialog 3)) (t (setq idx (- idx (* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa idx)) 4)) )") (setq Rep# 1) (repeat (fix No_Blks#) (setq ImageName$ (nth (+ (* Pg_No# 20) (- Rep# 1)) BlkList@)) (action_tile (strcat "sld" (itoa Rep#)) "(setq idx (+ (atoi (substr $key 4))(* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (mode_tile $key 4) (set_tile \"blocknameslist\" (itoa (- idx 1))) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t)") (start_image (strcat "sld" (itoa Rep#))) (slide_image 0 0 (dimx_tile (strcat "sld" (itoa Rep#))) (dimy_tile (strcat "sld" (itoa Rep#))) (strcat DefPath$ ImageName$ ".sld") ) (end_image) (set_tile (strcat "sld" (itoa Rep#) "text") ImageName$) (setq Rep# (1+ Rep#)) ) (if SlideRef$ (progn (print slideref$) (setq idx (- (atoi (vl-string-subst "" "sld" SlideRef$)) (* Pg_No# 20))) (print idx) (mode_tile (strcat "sld" (itoa idx)) 4) (set_tile "blocknameslist" (itoa (+ idx (* Pg_No# 20) -1))) ) (progn (setq idx (+ (* Pg_No# 20) 1)) (mode_tile "sld1" 4) (setq SlideRef$ (strcat "sld" (itoa idx))) (set_tile "blocknameslist" SlideRef$) ) ) (setq Option# (start_dialog)) (if (= Option# 4);next (setq Pg_No# (1+ Pg_No#) BlockLen# (- BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 3);previous (setq Pg_No# (- Pg_No# 1) BlockLen# (+ BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 2);cancel (setq Option# 1 SlideRef$ nil ) ) ) (unload_dialog Dcl_Id%) (if (and SlideRef$ Pick) (progn (setq Ref# (- (atoi (substr SlideRef$ 4)) 1)) (setq Block$ (nth Ref# BlkList@) Layer$ (nth Ref# LayerList@) Point@ (nth Ref# PointList@) Scale~ (nth Ref# ScaleList@) Explode$ (nth Ref# ExplodeList@) Attribs$ (nth Ref# AttribsList@) ) I have not look if any of the options are affected, but I don't think so. ymg Quote
wesleyaqua Posted April 4, 2014 Author Posted April 4, 2014 wesleyaqua, I believe I got it nailed! Try this latest: ;----------------------------------------------------------------------------- ; Load DCL dialog: Dwg_Blks in Blk_Lib.dcl ;----------------------------------------------------------------------------- (princ "\nSelect a block or option: ")(princ) (setq Dcl_Id% (load_dialog "Blk_Lib.dcl")) (while (/= Option# 1) (new_dialog "Dwg_Blks" Dcl_Id%) (start_list "blocknameslist") (mapcar 'add_list blklist@) (end_list) (set_tile "title" (strcat " " LibTitle$ " Library " (itoa (+ Pg_No# 1)) " of " (itoa (+ No_Pages# 1))) ) (if (= Pg_No# No_Pages#) (mode_tile "next" 1) (mode_tile "next" 0) ) (if (= Pg_No# 0) (mode_tile "previous" 1) (mode_tile "previous" 0) ) (if (> BlockLen# 19) (setq No_Blks# 20) (setq No_Blks# BlockLen#) ) (action_tile "next" "(setq Slideref$ nil) (done_dialog 4)") (action_tile "previous" "(setq Slideref$ nil) (done_dialog 3)") (action_tile "cancel" "(done_dialog 2)") (action_tile "select" "(done_dialog 1)") (action_tile "blocknameslist" "(setq idx (+ (atoi $value) 1)) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t) (cond ((> idx (+ (* Pg_No# 20) 20)) (done_dialog 4)) ((< idx (* Pg_No# 20)) (done_dialog 3)) (t (setq idx (- idx (* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa idx)) 4)) )") (setq Rep# 1) (repeat (fix No_Blks#) (setq ImageName$ (nth (+ (* Pg_No# 20) (- Rep# 1)) BlkList@)) (action_tile (strcat "sld" (itoa Rep#)) "(setq idx (+ (atoi (substr $key 4))(* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (mode_tile $key 4) (set_tile \"blocknameslist\" (itoa (- idx 1))) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t)") (start_image (strcat "sld" (itoa Rep#))) (slide_image 0 0 (dimx_tile (strcat "sld" (itoa Rep#))) (dimy_tile (strcat "sld" (itoa Rep#))) (strcat DefPath$ ImageName$ ".sld") ) (end_image) (set_tile (strcat "sld" (itoa Rep#) "text") ImageName$) (setq Rep# (1+ Rep#)) ) (if SlideRef$ (progn (print slideref$) (setq idx (- (atoi (vl-string-subst "" "sld" SlideRef$)) (* Pg_No# 20))) (print idx) (mode_tile (strcat "sld" (itoa idx)) 4) (set_tile "blocknameslist" (itoa (+ idx (* Pg_No# 20) -1))) ) (progn (setq idx (+ (* Pg_No# 20) 1)) (mode_tile "sld1" 4) (setq SlideRef$ (strcat "sld" (itoa idx))) (set_tile "blocknameslist" SlideRef$) ) ) (setq Option# (start_dialog)) (if (= Option# 4);next (setq Pg_No# (1+ Pg_No#) BlockLen# (- BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 3);previous (setq Pg_No# (- Pg_No# 1) BlockLen# (+ BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 2);cancel (setq Option# 1 SlideRef$ nil ) ) ) (unload_dialog Dcl_Id%) (if (and SlideRef$ Pick) (progn (setq Ref# (- (atoi (substr SlideRef$ 4)) 1)) (setq Block$ (nth Ref# BlkList@) Layer$ (nth Ref# LayerList@) Point@ (nth Ref# PointList@) Scale~ (nth Ref# ScaleList@) Explode$ (nth Ref# ExplodeList@) Attribs$ (nth Ref# AttribsList@) ) I have not look if any of the options are affected, but I don't think so. ymg yeah baby yeah that looks like what i have been struggling to i tried it with a 2 page file but i think there ain't a limit. also it tried selecting empty boxes but he ignores me so it doesn't fail there also. thank you very much for helping me getting this far. only 2 small ones (it isn't high priority) but if its simple fix why not. like double clicking also works on the image and if possible how to change the font of the list box or is it the same as the text under the image? couse that looks like a fine type and the listbox looks bolt maybe then. or could it be : list_box { label ="Block Selector"; key = "blocknameslist"; height = 50; width = 25; multiple_select = false; fixed_width_font = true; fixed_width_font is causing this ? Quote
wesleyaqua Posted April 4, 2014 Author Posted April 4, 2014 found it imlst : image_button {color = graphics_background; width = 25.92; height= 7.97; aspect_ratio = 1;allow_accept = true;) added the allow_accept saw that it stood at listbox and set fixed_width_font to false and it looks better now Quote
ymg3 Posted April 4, 2014 Posted April 4, 2014 wesleyaqua, There is still a little problem when we use the next and previous button. The highlighting in the listbox is not correct. ymg Quote
wesleyaqua Posted April 4, 2014 Author Posted April 4, 2014 ymg3 ;------------------------------------------------------------------------------- ; Revision History ; Rev By Date Description ;------------------------------------------------------------------------------- ; 1 TM 1-1-00 Initial version. ; 2 TM 2-1-00 Added c:Sel_Lib, Select Block Library. ; 3 TM 3-1-00 Revised c:InBlocks and c:All_Blk_Lib functions. ; 4 TM 4-1-00 Created and added GetIcon.lsp Get functions. ; 5 TM 5-1-00 Revised code for AutoCAD 2000 compatibility. ; 6 TM 12-1-00 Revised GetIcon.lsp to allow up to 4 lines and to allow ; choosing different icons. ; 7 TM 1-1-01 Included Blk_Lib as the main command function and added ; more icons to GetIcon.lsp. ; 8 TM 10-1-03 Added c:LIB, shortcut for c:Library, for a user version ; of Select Block Library. Included insertion dot as the ; default for slides. Allow user to control block rotation. ; 9 TM 10-20-03 Added Slide_Script function to be used with Select Block ; Library to add folders of drawings to Block Libraries. ; Added c:Mat, shortcut for c:Match, the Match Slides Game. ; 10 TM 5-20-04 Added GetDwgsList function to check if drawing environment ; is a Single Document Interface before running scripts. ; 11 TM 12-20-04 Revised code for AutoCAD 2005 compatibility. Redesigned ; the dialogs with slide images, and increased the width ; for block names to allow more room for longer block names. ; 12 TM 3-20-05 Detached GetIcon.lsp functions into a separate file. ; 13 TM 9-20-05 Revised some of the dialog control functions and reworded ; some of the dialog messages. ; 14 TM 7-20-06 Revised code for AutoCAD 2007 compatibility. ; 15 TM 11-30-07 Added runapp function for DOS applications. ; 16 TM 2-1-08 Revised INBL, shortcut for c:InBlocks function, to insert ; blocks from a folder of drawings into a blank drawing to ; manage and add blocks to Block Libraries. ; 17 TM 2-20-08 Added ADL, shortcut for c:Add_Dwgs function, to add a ; folder of drawings to a library without inserting them ; into a drawing. ; 18 ymg3 4/04/2014 made the added listbox working with a link between sld and listbox ; also the highlight is more clear now by showing the selected image with a white background i've added your name at the revision at the .lsp cause i cant take the honer of making it work i'll bakup the file so i dont lose it forgot to press reply at 9.30 saw your coment on the phone indeed the first one is highlighten and when pressed next but when you click on another on it works again good little problem maybe for you Quote
ymg3 Posted April 4, 2014 Posted April 4, 2014 (edited) wesleyaqua, Change this bit: (if SlideRef$ (progn (setq idx (- (atoi (substr SlideRef$ 4)) (* Pg_No# 20))) (mode_tile (strcat "sld" (itoa idx)) 4) (set_tile "blocknameslist" (itoa (- (atoi (substr SlideRef$ 4)) 1))) ) (progn (setq idx (+ (* Pg_No# 20) 1)) (mode_tile "sld1" 4) (setq SlideRef$ (strcat "sld" (itoa idx))) (set_tile "blocknameslist" (itoa (- (atoi (substr SlideRef$ 4)) 1))) ) ) Then test and re-test. And thanks for the attribution. One thing I don't like is after the dialog goes away you are waiting for the selection of a point. It would be nicer if at that point we would be dragging the block to its postion then rotate. All a matter of taste. It is however fairly complicated to implement because of that series of options. Glad, I could help. ymg Edited April 4, 2014 by ymg3 Change in Code Quote
Snownut Posted April 4, 2014 Posted April 4, 2014 When inserting blocks this way, I find it works well to automatically insert the block at center of screen (getvar 'viewctr). Then you can do a move & rotate, I developed this habit from creating "entmake insert's" so that it appears as if the insert command is being used. Quote
Snownut Posted April 4, 2014 Posted April 4, 2014 found it imlst : image_button {color = graphics_background; width = 25.92; height= 7.97; aspect_ratio = 1;allow_accept = true;) added the allow_accept saw that it stood at listbox and set fixed_width_font to false and it looks better now Glad to see you are already seeing the benefits of utilizing the DCL in this manner. Quote
ymg3 Posted April 4, 2014 Posted April 4, 2014 Snownut, This is what I normally do also. I find the feedback much more satisfying than picking a point empty-handed. ymg Quote
wesleyaqua Posted April 5, 2014 Author Posted April 5, 2014 Snownut, This is what I normally do also. I find the feedback much more satisfying than picking a point empty-handed. ymg Not shure what you mean with the feedback. You mean that the block hangt at your cursor. And then jou stil pick the point? I think this has to do with the explode command he doesnt explode but maybe by looking at it, he makes it dis appear. Like a normal insert with explode checked. Then you got also a blank cursor. Maybe you noticed there is a purple point at the image. That point represents the basepoint of the block also. But i also rather prefer that i see the block hanging at my cursor. Goodnight Quote
Snownut Posted April 5, 2014 Posted April 5, 2014 Here's a version that uses the preview icon image instead of having to create any slides, also contains self extracting DCL file. ;-------------------------------------------------------------------------------; ; Revision History ; ; Rev By Date Description ; ;-------------------------------------------------------------------------------; ; 1 TM 1-1-00 Initial version. ; ; 2 TM 2-1-00 Added c:Sel_Lib, Select Block Library. ; ; 3 TM 3-1-00 Revised c:InBlocks and c:All_Blk_Lib functions. ; ; 4 TM 4-1-00 Created and added GetIcon.lsp Get functions. ; ; 5 TM 5-1-00 Revised code for AutoCAD 2000 compatibility. ; ; 6 TM 12-1-00 Revised GetIcon.lsp to allow up to 4 lines and to allow ; ; choosing different icons. ; ; 7 TM 1-1-01 Included Blk_Lib as the main command function and added ; ; more icons to GetIcon.lsp. ; ; 8 TM 10-1-03 Added c:LIB, shortcut for c:Library, for a user version ; ; of Select Block Library. Included insertion dot as the ; ; default for slides. Allow user to control block rotation. ; ; 9 TM 10-20-03 Added Slide_Script function to be used with Select Block ; ; Library to add folders of drawings to Block Libraries. ; ; Added c:Mat, shortcut for c:Match, the Match Slides Game. ; ; 10 TM 5-20-04 Added GetDwgsList function to check if drawing environment; ; is a Single Document Interface before running scripts. ; ; 11 TM 12-20-04 Revised code for AutoCAD 2005 compatibility. Redesigned ; ; the dialogs with slide images, and increased the width ; ; for block names to allow more room for longer block names.; ; 12 TM 3-20-05 Detached GetIcon.lsp functions into a separate file. ; ; 13 TM 9-20-05 Revised some of the dialog control functions and reworded ; ; some of the dialog messages. ; ; 14 TM 7-20-06 Revised code for AutoCAD 2007 compatibility. ; ; 15 TM 11-30-07 Added runapp function for DOS applications. ; ; 16 TM 2-1-08 Revised INBL, shortcut for c:InBlocks function, to insert ; ; blocks from a folder of drawings into a blank drawing to ; ; manage and add blocks to Block Libraries. ; ; 17 TM 2-20-08 Added ADL, shortcut for c:Add_Dwgs function, to add a ; ; folder of drawings to a library without inserting them ; ; into a drawing. ; ; 18 ymg3 4/04/2014 made the added listbox working with a link between sld ; ; and listbox also the highlight is more clear now by ; ; showing the selected image with a white background ; (defun c:block_lib ( / file dcl img dirtxt blklist% Blklist@ BlockLen# libtitle$ No_Pages# Pg_No# Option# tmp DCL_Id% ) (vl-load-com) ; The Purpose of the code: Read the thumbnail of dwg and show it in the DCL ; Wrote by: szmaicy, Email£ºszmaicy@gmail.com ; Thanks to nonsmall who provide the code of reading binary file. (defun mai_get_dwg_preview ( tfile imgx imgy / stream vecters row column bmp_widx bmp_widy loa loabmp lenbmp start_x start_y scale color_num color_list tt2 get_len fix_widx mm re_row mai_10->16 mai_16->10 mai_stream_lst->num mai_read_stream mai_rgb->aci mai_stream_just ) ;Convert a decimal number to a string list (sexadecimal) (defun mai_10->16 ( num / e n ) (setq e "") (while (/= 0 num) (setq e (strcat (nth (rem num 16) (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F")) e) num (fix (/ num 16)) ) ) (cond ((= e "") "00") ((= (rem (strlen e) 2) 1) (strcat "0" e)) (e) ) ) ;Convert a string list (sexadecimal) to a decimal number (defun mai_16->10 ( txt / e n nn) (setq e 0 txt (vl-string->list (strcase txt)) n (length txt) ) (foreach nn txt (setq n (1- n)) (if (/= nn "0") (setq nn (length (member (vl-list->string (list nn)) (list "F" "E" "D" "C" "B" "A" "9" "8" "7" "6" "5" "4" "3" "2" "1") ) ) e (+ e (* nn (expt 16 n))) ) ) ) e ) ;Convert a list to a decimal number (defun mai_stream_lst->num (lst / ) (mai_16->10 (apply 'strcat (mapcar 'mai_10->16 lst)))) ; Convert the byte(at "po" position and has "len" length") to sty [a decimal number-num, or list, or stream or string-str) ; po: the position of the byte ; len: the length of the reading byte ; sty: the reading results, maybe number "num", list "list" or string "str" (defun mai_read_stream ( xstream po len sty / a ) (vlax-put xstream 'position (if po po 0)) (setq a (vlax-invoke-method xstream 'read (if len len (vlax-get xstream 'size))) sty (strcase sty) ) (cond ((= sty "STREAM") a) (T (setq a (vlax-safearray->list (vlax-variant-value a)) a (mapcar '(lambda (x) (- x mai_stream_just)) a) ) (cond ((= sty "LIST") a) ((= sty "NUM") (mai_stream_lst->num (reverse a))) ((= sty "STR") (setq a (reverse a)) (while (= (car a) 0) (setq a (cdr a))) (if a (vl-list->string (reverse a))) ) ) ) ) ) ;trans RGB color to ACAD index color (defun mai_rgb->aci (rgb-codes) (setq ColorObj (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2)) ) ) (vla-setRGB ColorObj (car RGB-codes) (cadr RGB-codes) (caddr RGB-codes)) (vla-get-ColorIndex ColorObj) ) ;merge the same color of one line which is Adjacent ;ignore the point whose color index is 0 ( color index, start x coordinate, end x coordinate (defun get_len (lst / m n a e1 elb ) (setq n 0 m 0 a (car lst)) (foreach b lst (setq n (1+ n)) (if (not (= a b)) (setq e1 (if (= a 0) e1 (cons (list a m (+ m n)) e1)) a b m (+ m n) n 0 ) ) ) (if (= a 0) e1 (cons (list a m (+ m n)) e1) ) ) (vl-catch-all-apply '(lambda () (setq stream (vlax-get-or-create-object "adodb.stream")) (vlax-invoke stream 'open ) (vlax-put-property stream 'type 1) (vlax-invoke-method stream 'loadfromfile tfile) (vlax-put stream 'position 0) (setq mai_stream_just (- (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read 2)))) 65)) ;use the following value so as the different acad version can read the same binary value, the result is between 0-255 (setq loa (+ (mai_read_stream stream 13 4 "num") 30));the 14th~17th record position + 30 byte record the image position (if (and (= 2 (mai_read_stream stream loa 1 "num")) (> (setq loabmp (mai_read_stream stream (1+ loa) 4 "num")) 0);The start point of the image (> (setq lenbmp (mai_read_stream stream (+ loa 5) 4 "num")) 0);the byte length of the image (> (setq bmp_widx (mai_read_stream stream (+ 4 loabmp) 4 "num")) 0);read the width of the image (> (setq bmp_widy (mai_read_stream stream (+ 8 loabmp) 4 "num")) 0);read the height of the image (= 1 (mai_read_stream stream (+ 12 loabmp) 2 "num"));non-compress format (= 8 (mai_read_stream stream (+ 14 loabmp) 2 "num"));8 bit color(256 color) (setq color_num (1- (mai_read_stream stream (+ 32 loabmp) 2 "num")));the amount of the color index ) (progn (setq fix_widx (* 4 (1+ (fix (* 0.25 (1- bmp_widx))))) ;each line must be a multiple of 4 loa (+ (- lenbmp (* fix_widx bmp_widy) (* 4 color_num)) loabmp);the pointer position, every 4 byte record a RGB color ) (repeat color_num (setq color_list (cons (mai_rgb->aci (cdr (reverse (mai_read_stream stream loa 4 "list")))) color_list) loa (+ loa 4) ) );Read all the color(True Color) index table, they must be convert to 256 index color. (if (not (and imgx imgy)) (setq imgx bmp_widx imgy bmp_widy));redefine the width and height of the image (setq scale (min (/ imgx (float bmp_widx)) (/ imgy (float bmp_widy)));redefine the ratio of the width and height start_x (fix (* 0.5 (- imgx (* bmp_widx scale))));the x coordinate of the left top corner start_y (fix (* 0.5 (- imgy (* bmp_widy scale))));the y coordinate of the right top corner row (1+ bmp_widy);the line number of the image ) (repeat bmp_widy (vlax-put stream 'position loa) (setq loa (+ loa fix_widx);the pointer position row (1- row);the line number of the image img_row (fix (+ start_y 0.5 (* scale row)));the y coordinate after the scaling re_row (- img_row (fix (+ start_y 0.5 (* scale (1- row))))) re_row (if (< re_row 2) 1 re_row);the repeat number of each line when zooming in the image mm (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read bmp_widx))) mm (mapcar '(lambda (x) (- x mai_stream_just)) mm) ) ;readline bmp, from bottom to top, from left to right (foreach tt2 (get_len mm) (setq mm 0) (repeat re_row ;the repeat number of each line when zooming in the image, which means the blank point between this line and the next line when filling and zoom this image (setq vecters (cons (list (fix (+ start_x 0.5 (* scale (cadr tt2))));the x coordinate of the start point after scaling (+ mm img_row) (fix (+ start_x 0.5 (* scale (caddr tt2))));the x coordinate of the end point after scaling (+ mm img_row) (nth (- color_num (car tt2)) color_list);get true color from the index table ) vecters ) mm (1- mm) ) ) ) ) ) ) (and stream (vlax-invoke stream 'close)) (and stream (vlax-release-object stream)) (setq vecters (cons (list start_x start_y (fix (+ start_x 0.5 (* scale bmp_widx))) (fix (+ start_x 0.5 (* scale bmp_widy))) -2 );add the background color coordinate to the first item vecters) ) ) ) vecters ) (defun slide_image_dwg ( image dwgfile color / lenx leny img_date ) (setq lenx (dimx_tile image) leny (dimy_tile image) img_date (cdr (mai_get_dwg_preview dwgfile lenx leny)) ) (start_image image) (fill_image 0 0 lenx leny color) (if img_date (mapcar '(lambda (x) (apply 'vector_image x)) img_date)) (end_image) (princ) ) (defun writedcl (/ des tmp snmbr tnmbr txtL) (setq tmp (vl-filename-mktemp nil nil ".dcl") des (open tmp "w") snmbr 1 tnmbr 1 txtL '(" : column {") ) (repeat 4 (setq txtL (append txtL '(" : row {"))) (repeat 5 (setq txtL (append txtL (list (strcat " : imlst { key = \"sld" (itoa snmbr)"\" ; }"))) snmbr (1+ snmbr) ) ) (setq txtL (append txtL '(" }") '(" : row {"))) (repeat 5 (setq txtL (append txtL (list (strcat " : column {: txlst { key = \"sld" (itoa tnmbr)"text\" ; }}"))) tnmbr (1+ tnmbr) ) ) (setq txtL (append txtL '(" }"))) );repeat (setq txtL (append txtL '(" }") '(" }")) txtL (append (list "imlst : image_button { color = dialog_background; width = 25.92; height= 7.97; aspect_ratio = 1; allow_accept = true;}" "txlst : text {label = \"\"; width = 25.92; fixed_width = false; alignment = centered; }" "Dwg_Blks : dialog { label = \"User Library Block Selector\"; key = \"title\"; initial_focus = \"cancel\";" " spacer;" " : row {" " : column {" " : list_box { label =\"Block Selector\"; key = \"blocknameslist\"; allow_accept = true;" " multiple_select = false; height = 50; width = 25; fixed_width_font = true; }" " }" ) txtL (list " : row {" " : column {" " : button { key = \"previous\"; label = \"< Previous\"; mnemonic = \"P\";" " width = 70; fixed_width = true; alignment = centered; }" " : ok_button { mnemonic = \"O\"; alignment = right; width = 11; }" " }" " : column {" " : button { key = \"next\"; label = \"Next >\"; mnemonic = \"N\";" " width = 70; fixed_width = true; alignment = centered; }" " : cancel_button { mnemonic = \"C\"; alignment = left; width = 11; }" " }" " }" "}" ) ) ) (foreach line txtL (write-line line des) );foreach (not (setq des (close des))) tmp );defun (writedcl) Continued to next post... Quote
Snownut Posted April 5, 2014 Posted April 5, 2014 Add this to previous post for complete code. ;----------------------------------------------------------------------------- ; Load DCL dialog: Dwg_Blks in Blk_Lib.dcl ;----------------------------------------------------------------------------- (princ "\nSelect a block or option: ")(princ) (setq dirtxt (vl-filename-directory (getfiled "Select Library Directory:" "C:" "dwg" 16)) blklist% (vl-directory-files dirtxt "*.dwg" 1) BlkList@ blklist% BlockLen# (length blklist%) libtitle$ "User Blocks" No_Pages# (/ BlockLen# 20) Pg_No# 0 Option# 0 ) (setq tmp (writedcl) Dcl_Id% (load_dialog tmp) ) ; (setq Dcl_Id% (load_dialog "Blk_Lib.dcl")) (while (/= Option# 1) (if (not(new_dialog "Dwg_Blks" Dcl_Id%)) (progn (alert "\nUnable to load dialog.") (exit) ) );end if (start_list "blocknameslist") (mapcar 'add_list blklist@) (end_list) (set_tile "title" (strcat " " LibTitle$ " Library " (itoa (+ Pg_No# 1)) " of " (itoa (+ No_Pages# 1))) ) (if (= Pg_No# No_Pages#) (mode_tile "next" 1) (mode_tile "next" 0) ) (if (= Pg_No# 0) (mode_tile "previous" 1) (mode_tile "previous" 0) ) (if (> BlockLen# 19) (setq No_Blks# 20) (setq No_Blks# BlockLen#) ) (action_tile "next" "(setq Slideref$ nil) (done_dialog 4)") (action_tile "previous" "(setq Slideref$ nil) (done_dialog 3)") (action_tile "cancel" "(done_dialog 2)") (action_tile "select" "(done_dialog 1)") (action_tile "blocknameslist" "(setq idx (+ (atoi $value) 1)) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t) (cond ((> idx (+ (* Pg_No# 20) 20)) (done_dialog 4)) ((< idx (* Pg_No# 20)) (done_dialog 3)) (t (setq idx (- idx (* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa idx)) 4)) )") (setq Rep# 1) (repeat (fix No_Blks#) (setq ImageName$ (nth (+ (* Pg_No# 20) (- Rep# 1)) BlkList@)) (action_tile (strcat "sld" (itoa Rep#)) "(setq idx (+ (atoi (substr $key 4))(* Pg_No# 20))) (mode_tile (strcat \"sld\" (itoa (- (atoi (substr SlideRef$ 4))(* Pg_No# 20)))) 4) (mode_tile $key 4) (set_tile \"blocknameslist\" (itoa (- idx 1))) (setq SlideRef$ (strcat \"sld\" (itoa idx)) Pick t)") (slide_image_dwg (strcat "sld" (itoa Rep#)) (strcat dirtxt "\\" ImageName$) -15) (set_tile (strcat "sld" (itoa Rep#) "text") ImageName$) (setq Rep# (1+ Rep#)) ) (if SlideRef$ (progn (setq idx (- (atoi (substr SlideRef$ 4)) (* Pg_No# 20))) (mode_tile (strcat "sld" (itoa idx)) 4) (set_tile "blocknameslist" (itoa (- (atoi (substr SlideRef$ 4)) 1))) ) (progn (setq idx (+ (* Pg_No# 20) 1)) (mode_tile "sld1" 4) (setq SlideRef$ (strcat "sld" (itoa idx))) (set_tile "blocknameslist" (itoa (- (atoi (substr SlideRef$ 4)) 1))) ) ) (setq Option# (start_dialog)) (if (= Option# 4);next (setq Pg_No# (1+ Pg_No#) BlockLen# (- BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 3);previous (setq Pg_No# (- Pg_No# 1) BlockLen# (+ BlockLen# 20) ;SlideRef$ nil ) ) (if (= Option# 2);cancel (setq Option# 1 SlideRef$ nil ) ) ) (unload_dialog Dcl_Id%) (if (and SlideRef$ Pick) (progn (setq Ref# (- (atoi (substr SlideRef$ 4)) 1) Block$ (nth Ref# BlkList@) ) ) ) T );defun (princ "\nType [block_Lib]") (princ) Very good job YMG. This one takes a second or so to fill in image buttons due to conversion process. Also works in Bricscad 14. Bruce Quote
ymg3 Posted April 5, 2014 Posted April 5, 2014 Snownut, Good job also. The delay is not much worse, if any, than it was. You've also included the generation of the dcl in the lisp. ymg Quote
wesleyaqua Posted April 7, 2014 Author Posted April 7, 2014 Snownut i don't get yours working i probably insert your codes at the wrong position. do i need to place the whole code at load dcl ? from start till-> ;------------------------------------------------------------------------------- ; c:Library - Select Block Library ;------------------------------------------------------------------------------- and the first one is that till ;------------------------------------------------------------------------------- ; Overview of Main Functions ;------------------------------------------------------------------------------- ymg3 i replaced the code also now it works here also good. Quote
ymg3 Posted April 7, 2014 Posted April 7, 2014 wesleyaqua, be aware that the method of reading the drawing to get the thumbnail work only up to release 2013. Up to there the preview image was stored as a bmp image. From 2013 the png format is used, and szmaicy's code does not handle it. ymg Quote
wesleyaqua Posted April 7, 2014 Author Posted April 7, 2014 ymg3 okay thats why was testing at 2014. so i'll use your programe then. cause were starting to use 2015 now. Wesley Quote
ymg3 Posted April 7, 2014 Posted April 7, 2014 Although I have no means to check it, if your blocks are saved in a version prior to 2013, it should work. For example your test library seems to be saved in an older version cause it works for me. ymg Quote
wesleyaqua Posted April 7, 2014 Author Posted April 7, 2014 then i probably mis placed some cause their probably saved in 2004 or 2007. gone try it tonight at my own pc to get it working. although thx for the help already Wesley Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.