exceed Posted May 11, 2022 Posted May 11, 2022 (edited) ; BMP, BMP1, BMP2, BMP3 - 2022.05.18 exceed ; insert bmp file into dwg. ; https://www.cadtutor.net/forum/topic/75162-bmp-file-to-polyline-mosaic/ ; Command list ; BMP - Line (1 width horizontal polyline) ; BMP1 - Line with Grayscale (1 width horizontal polyline) ; BMP2 - Dot (1 length x 1 width polyline mosaic) ; BMP3 - Hatch (not completed function*, clean up the vertices of polylines and make them hatches.) ; since this lisp converts the r, g and b values of every pixel into a list, ; for a 100x100 image it creates a list with at least 30000 members. ; therefore, it is recommended to execute after reducing the size to 300x300 or less. ; when converting in the ms paint, select a 24-bit bitmap. ; version 2 updated ; - edit skipper variable calculation - more bmp files supported without errors. ; - support 32-bit bmp file also, but alpha channel is not used for polyline expression. ; - add option for grayscale (BMP1), dotted outline (BMP3) ; version 3 updated ; - add option for hatches (BMP3), ; the number of hatches is reduced to close to the number of colors used ; but I don't know if it will be useful because the hatch itself is slower than the lwpolyline. this is just for my study. ; Because "command" is used, it may not work depending on the type of CAD. Tested at zwcad2022. ; Background removal doesn't work. Only aci colors are available.) (vl-load-com) (defun c:BMP ( / bitmapbit useskipper blockpt blocknumber blockname compactrow compactlist compactcell compactlen pxsrow pxsrowlen pxscell pxslen exrmin exrmax exgmin exgmax exbmin exbmax path file lst listlen bitmapfileheader b c bitmapinfoheader widtha widthb widthc widthd biwidth heighta heightb heightc heightd biheight bitmapdata basept baseptx xreturn basepty ss exceptionyn exceptionr exceptiong exceptionb exceptionpixel 1rowdata pblue pgreen pred pixel skipper pixellist pixelcounter pixelrowstack oldpixel pixelstack psl indexr indexc row collen cell exceptionrange exceptionmin exceptionmax aciyn) (setq pixelstack (ex:BMPSTEP1)) (setq pxslen (length pixelstack)) ;(princ pixelstack) (if (= (strcase aciyn) "Y") (setq oldpixel 16777400) ; different with exception color (setq oldpixel 888) ; different with exception color ) (setq compactlist '()) (repeat pxslen (setq pxsrow (car pixelstack)) (setq pxsrowlen (length pxsrow)) (setq pixelcounter 1) (setq compactrow '()) (repeat (- pxsrowlen 1) (setq pxscell (car pxsrow)) (if (= oldpixel pxscell) (progn (setq pixelcounter (+ pixelcounter 1)) ) (progn (setq compactcell (list oldpixel pixelcounter)) (setq compactrow (cons compactcell compactrow)) (setq pixelcounter 1) ) );end of if (setq oldpixel pxscell) (setq pxsrow (cdr pxsrow)) );end of repeat (setq pxscell (car pxsrow)) (if (= oldpixel pxscell) (progn (setq pixelcounter (+ pixelcounter 1)) (setq compactcell (list pxscell pixelcounter)) (setq compactrow (cons compactcell compactrow)) ) (progn (setq compactcell (list oldpixel pixelcounter)) (setq compactrow (cons compactcell compactrow)) (setq pixelcounter 1) (setq compactcell (list pxscell pixelcounter)) (setq compactrow (cons compactcell compactrow)) ) );end of if (setq pixelcounter 1) (if (= (strcase aciyn) "Y") (setq oldpixel 16777400) ; different with exception color (setq oldpixel 888) ; different with exception color ) (setq compactlist (cons (cdr (reverse compactrow)) compactlist)) (setq pixelstack (cdr pixelstack)) );end of repeat (setq compactlist (reverse compactlist)) ;(princ compactlist) (setq compactlen (length compactlist)) (setq indexr 0) (repeat compactlen (setq row (nth indexr compactlist)) (setq collen (length row)) (setq indexc 0) (repeat collen (setq cell (nth indexc row)) (cond ((= (strcase aciyn) "Y") (if (/= (car cell) 16777300) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 (car cell)) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (cadr cell)) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) ) ((/= (strcase aciyn) "Y") (if (/= (car cell) 999) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 (car cell)) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (cadr cell)) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) ) );end of cond (setq baseptx (+ baseptx (cadr cell))) (setq indexc (+ indexc 1)) );end of repeat column (setq baseptx xreturn) (setq basepty (+ basepty 1)) (setq indexr (+ indexr 1)) );end of repeat row (if (= (sslength ss) 0) (progn (princ "\n BMP - nothing to make, edit exception range") ) (progn (princ "\n BMP - process complete, result = ") (princ (sslength ss)) (princ " lines.") ;;; Tharwat 11. May. 2012 ;; (setq blocknumber 1) (setq blockname (strcat "BMP" (itoa blocknumber))) (while (tblsearch "BLOCK" blockname) (setq blockname (strcat "BMP" (itoa (setq blocknumber (+ blocknumber 1))))) ) (setq blockpt (list (car basept) (- (cadr basept) 0.5) (caddr basept))) (setvar 'cmdecho 0) (command "_.-block" blockname blockpt ss "") (command "_.-insert" blockname blockpt "" "" "") (setvar 'cmdecho 1) ) ) (princ) ) (defun c:BMP1 ( / pgray bitmapbit useskipper blockpt blocknumber blockname compactrow compactlist compactcell compactlen pxsrow pxsrowlen pxscell pxslen exrmin exrmax exgmin exgmax exbmin exbmax path file lst listlen bitmapfileheader b c bitmapinfoheader widtha widthb widthc widthd biwidth heighta heightb heightc heightd biheight bitmapdata basept baseptx xreturn basepty ss exceptionyn exceptionr exceptiong exceptionb exceptionpixel 1rowdata pblue pgreen pred pixel skipper pixellist pixelcounter pixelrowstack oldpixel pixelstack psl indexr indexc row collen cell exceptionrange exceptionmin exceptionmax aciyn) (setq pixelstack (ex:BMPSTEP1GRAY)) (setq pxslen (length pixelstack)) ;(princ pixelstack) (setq oldpixel 888) ; different with exception color (setq compactlist '()) (repeat pxslen (setq pxsrow (car pixelstack)) (setq pxsrowlen (length pxsrow)) (setq pixelcounter 1) (setq compactrow '()) (repeat (- pxsrowlen 1) (setq pxscell (car pxsrow)) (if (= oldpixel pxscell) (progn (setq pixelcounter (+ pixelcounter 1)) ) (progn (setq compactcell (list oldpixel pixelcounter)) (setq compactrow (cons compactcell compactrow)) (setq pixelcounter 1) ) );end of if (setq oldpixel pxscell) (setq pxsrow (cdr pxsrow)) );end of repeat (setq pxscell (car pxsrow)) (if (= oldpixel pxscell) (progn (setq pixelcounter (+ pixelcounter 1)) (setq compactcell (list pxscell pixelcounter)) (setq compactrow (cons compactcell compactrow)) ) (progn (setq compactcell (list oldpixel pixelcounter)) (setq compactrow (cons compactcell compactrow)) (setq pixelcounter 1) (setq compactcell (list pxscell pixelcounter)) (setq compactrow (cons compactcell compactrow)) ) );end of if (setq pixelcounter 1) (setq oldpixel 888) ; different with exception color (setq compactlist (cons (cdr (reverse compactrow)) compactlist)) (setq pixelstack (cdr pixelstack)) );end of repeat (setq compactlist (reverse compactlist)) ;(princ compactlist) (setq compactlen (length compactlist)) (setq indexr 0) (repeat compactlen (setq row (nth indexr compactlist)) (setq collen (length row)) (setq indexc 0) (repeat collen (setq cell (nth indexc row)) (cond ((= (strcase aciyn) "Y") (if (/= (car cell) 16777300) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 (car cell)) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (cadr cell)) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) ) ((/= (strcase aciyn) "Y") (if (/= (car cell) 999) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 (car cell)) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (cadr cell)) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) ) );end of cond (setq baseptx (+ baseptx (cadr cell))) (setq indexc (+ indexc 1)) );end of repeat column (setq baseptx xreturn) (setq basepty (+ basepty 1)) (setq indexr (+ indexr 1)) );end of repeat row (if (= (sslength ss) 0) (progn (princ "\n BMP - nothing to make, edit exception range") ) (progn (princ "\n BMP - process complete, result = ") (princ (sslength ss)) (princ " lines.") ;;; Tharwat 11. May. 2012 ;; (setq blocknumber 1) (setq blockname (strcat "BMP" (itoa blocknumber))) (while (tblsearch "BLOCK" blockname) (setq blockname (strcat "BMP" (itoa (setq blocknumber (+ blocknumber 1))))) ) (setq blockpt (list (car basept) (- (cadr basept) 0.5) (caddr basept))) (setvar 'cmdecho 0) (command "_.-block" blockname blockpt ss "") (command "_.-insert" blockname blockpt "" "" "") (setvar 'cmdecho 1) ) ) (princ) ) (defun c:BMP2 ( / bitmapbit useskipper blockpt blocknumber blockname pxsrow pxsrowlen pxscell pxslen exrmin exrmax exgmin exgmax exbmin exbmax path file lst listlen bitmapfileheader b c bitmapinfoheader widtha widthb widthc widthd biwidth heighta heightb heightc heightd biheight bitmapdata basept baseptx xreturn basepty ss exceptionyn exceptionr exceptiong exceptionb exceptionpixel 1rowdata pblue pgreen pred pixel skipper exceptionrange exceptionmin exceptionmax aciyn acicolor) (setq pixelstack (ex:BMPSTEP1)) (setq pxslen (length pixelstack)) ;(princ pixelstack) (repeat pxslen (setq pxsrow (car pixelstack)) (setq pxsrowlen (length pxsrow)) (repeat pxsrowlen (setq pxscell (car pxsrow)) (if (= (strcase aciyn) "Y") (progn (if (/= pxscell 16777300) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscell) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) );end of progn (progn (if (/= pxscell 999) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscell) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 1) (cons 38 0) (cons 39 0) (cons 10 (list baseptx basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) basepty)) (cons 40 1) (cons 41 1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ) );end of progn );end of if (setq baseptx (+ baseptx 1)) (setq pxsrow (cdr pxsrow)) );end of repeat (setq baseptx xreturn) (setq basepty (+ basepty 1)) (setq pixelstack (cdr pixelstack)) );end of repeat (if (= (sslength ss) 0) (progn (princ "\n BMP - nothing to make, edit exception range") ) (progn (princ "\n BMP - process complete, result = ") (princ (sslength ss)) (princ " lines.") ;;; Tharwat 11. May. 2012 ;; (setq blocknumber 1) (setq blockname (strcat "BMP" (itoa blocknumber))) (while (tblsearch "BLOCK" blockname) (setq blockname (strcat "BMP" (itoa (setq blocknumber (+ blocknumber 1))))) ) (setq blockpt (list (car basept) (- (cadr basept) 0.5) (caddr basept))) (setvar 'cmdecho 0) (command "_.-block" blockname blockpt ss "") (command "_.-insert" blockname blockpt "" "" "") (setvar 'cmdecho 1) ) ) (princ) ) (defun c:BMP3 ( / acdoc sshatch2len sshatch2index obj objcoord objcol2 objcoordlen obj1st obj2nd newobjcoord objcoordindex objcoordx1 objcoordy1 objcoordx2 objcoordy2 objcoordx3 objcoordy3 sshatch4 ssindex hatchcolorlist2 hatchcolorlistlen hatchcolorlist sshatch3 sshatch2 sshatch sscol pixelstackcell2 pxscellcolor pxscellborder border bitmapbit useskipper blockpt blocknumber blockname pxsrow pxsrowlen pxscell pxslen exrmin exrmax exgmin exgmax exbmin exbmax path file lst listlen bitmapfileheader b c bitmapinfoheader widtha widthb widthc widthd biwidth heighta heightb heightc heightd biheight bitmapdata basept baseptx xreturn basepty ss exceptionyn exceptionr exceptiong exceptionb exceptionpixel 1rowdata pblue pgreen pred pixel skipper exceptionrange exceptionmin exceptionmax aciyn acicolor) (setq pixelstack (ex:BMPSTEP1)) (if (= (strcase aciyn) "Y") (setq pixelstackcell1 16777300) (setq pixelstackcell1 999) ) (setq pixelstack (ex:MakeFrameForMatrix pixelstack pixelstackcell1)) (setq pxslen (length pixelstack)) ;(princ pixelstack) (setq indexh2 1) (setq pixelstack2 '()) (repeat (- pxslen 2) (setq pixel1strow (nth indexh2 pixelstack)) (setq pixelrowlen (length pixel1strow)) (setq indexh3 1) (setq pixelstackrow2 '()) (repeat (- pixelrowlen 2) (setq pixelstackcell1 (nth indexh3 pixel1strow)) (setq border 0) (if (/= pixelstackcell1 (nth (+ indexh3 1) pixel1strow)) (setq border (+ border 1)) ) (if (/= pixelstackcell1 (nth (- indexh3 1) pixel1strow)) (setq border (+ border 2)) ) (if (/= pixelstackcell1 (nth indexh3 (nth (- indexh2 1) pixelstack)) ) (setq border (+ border 4)) ) (if (/= pixelstackcell1 (nth indexh3 (nth (+ indexh2 1) pixelstack)) ) (setq border (+ border 8)) ) (setq pixelstackcell2 (list pixelstackcell1 border)) (setq pixelstackrow2 (cons pixelstackcell2 pixelstackrow2)) (setq indexh3 (+ indexh3 1)) ) (setq pixelstack2 (cons (reverse pixelstackrow2) pixelstack2)) (setq indexh2 (+ indexh2 1)) ) (setq pixelstack2 (reverse pixelstack2)) ;(princ pixelstack2) (setq pixelstack pixelstack2) ;(princ pixelstack) (repeat (- pxslen 2) (setq pxsrow (car pixelstack)) (setq pxsrowlen (length pxsrow)) (setq baseptx xreturn) (repeat pxsrowlen (setq pxscell (car pxsrow)) (setq pxscellcolor (car pxscell)) (setq pxscellborder (cadr pxscell)) (if (= (strcase aciyn) "Y") (progn (if (/= pxscell 16777300) (progn (cond ((= pxscellborder 0)) ((= pxscellborder 1) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 2) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 3) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 4) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 5) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 6) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 7) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 8) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 9) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 10) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 11) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 12) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 13) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 14) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 15) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 420 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) );end of cond ) ) );end of progn (progn (if (/= pxscell 999) (progn (cond ((= pxscellborder 0)) ((= pxscellborder 1) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 2) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 3) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 4) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 5) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 6) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 7) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 8) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 9) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 10) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 11) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 12) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 13) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 14) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) ((= pxscellborder 15) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (- basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 pxscellcolor) (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list baseptx (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 1) (+ basepty 0.5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss) ) );end of cond ) ) );end of progn );end of if (setq baseptx (+ baseptx 1)) (setq pxsrow (cdr pxsrow)) );end of repeat (setq basepty (+ basepty 1)) (setq pixelstack (cdr pixelstack)) );end of repeat (if (= (sslength ss) 0) (progn (princ "\n BMP - nothing to make, edit exception range") ) (progn (princ "\n BMP - process complete, result = ") (princ (sslength ss)) (princ " lines.") (if (= (strcase aciyn) "Y") (exit) ) (setq ssindex 0) (setq hatchcolorlist '()) (repeat (sslength ss) (setq sscol (cdr (assoc 62 (entget (ssname ss ssindex))))) (setq hatchcolorlist (cons sscol hatchcolorlist)) (setq ssindex (+ ssindex 1)) ) (setq hatchcolorlist (LM:unique hatchcolorlist)) (princ "\n used colors - ") (princ hatchcolorlist) (setq hatchcolorlist2 hatchcolorlist) (setq hatchcolorlistlen (length hatchcolorlist)) (setvar 'cmdecho 0) (repeat hatchcolorlistlen (setq hatchcolorset (car hatchcolorlist)) (setq sshatch (ssget "c" (list (- xreturn 0.5) (- yreturn 0.5) 0) (list baseptx (+ basepty 0.5) 0) (list (cons 0 "lwpolyline") (cons 62 hatchcolorset)) )) (command "_.mpedit" sshatch "" "_j" "0.0" "") (setq hatchcolorlist (cdr hatchcolorlist)) ) (setq sshatch2 (ssget "c" (list (- xreturn 0.5) (- yreturn 0.5) 0) (list baseptx (+ basepty 0.5) 0) (list (cons 0 "lwpolyline")) )) (setq sshatch2len (sslength sshatch2)) (setq sshatch2index 0) (setq AcDoc (vla-get-activedocument (vlax-get-Acad-Object))) (cond ((= (vla-get-activespace AcDoc) 1) (setq AcSpace (vla-get-modelspace AcDoc))) ((= (vla-get-activespace AcDoc) 0) (setq AcSpace (vla-get-paperspace AcDoc))) ) (defun safefill ( PtList ) (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length PtList)))) PtList ) ) (defun LWPoly (lst cls col) ; LM's entmake functions (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 62 col) (cons 90 (length lst)) (cons 70 cls) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (repeat sshatch2len (setq obj (vlax-ename->vla-object (ssname sshatch2 sshatch2index))) (setq objcoord '()) (setq objcoord (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates)))) (setq objcol2 (vlax-get-property obj 'color)) (setq objcoordlen 0) (setq objcoordlen (length objcoord)) (if (> objcoordlen 8) (progn (princ "\n objcoordlen - ") (princ objcoordlen) (setq obj1st (car objcoord)) (setq obj2nd (cadr objcoord)) (setq objcoord (reverse objcoord)) (setq objcoord (append (list obj2nd obj1st) objcoord)) (setq objcoord (reverse objcoord)) (setq objcoordlen 0) (setq objcoordlen (length objcoord)) (setq newobjcoord '()) (setq newobjcoord (list (list (car objcoord) (cadr objcoord)))) (setq objcoordindex 0) (repeat (- (/ objcoordlen 2) 2) (setq objcoordx1 (nth objcoordindex objcoord)) (setq objcoordy1 (nth (+ objcoordindex 1) objcoord)) (setq objcoordx2 (nth (+ objcoordindex 2) objcoord)) (setq objcoordy2 (nth (+ objcoordindex 3) objcoord)) (setq objcoordx3 (nth (+ objcoordindex 4) objcoord)) (setq objcoordy3 (nth (+ objcoordindex 5) objcoord)) (if (or (= objcoordx1 objcoordx2 objcoordx3) (= objcoordy1 objcoordy2 objcoordy3)) (progn) (progn (setq newobjcoord (cons (list objcoordx2 objcoordy2) newobjcoord)) ) ) (setq objcoordindex (+ objcoordindex 2)) ) (setq newobjcoord (reverse newobjcoord)) (vla-delete obj) (LWPoly newobjcoord 1 objcol2) );end of progn (progn (setq newobjcoord objcoord) ) );end of if (setq sshatch2index (+ sshatch2index 1)) ) (command "_.-hatch" "_p" "SOLID" "_a" "i" "y" "s" "n" "" "") (repeat hatchcolorlistlen (setq hatchcolorset (car hatchcolorlist2)) (setq sshatch3 (ssget "c" (list (- xreturn 0.5) (- yreturn 0.5) 0) (list baseptx (+ basepty 0.5) 0) (list (cons 0 "lwpolyline") (cons 62 hatchcolorset)) )) (command "_.-hatch" "_s" sshatch3 "" "_co" hatchcolorset "" "") (setq hatchcolorlist2 (cdr hatchcolorlist2)) ) (setq sshatch4 (ssget "c" (list (- xreturn 0.5) (- yreturn 0.5) 0) (list baseptx (+ basepty 0.5) 0) (list (cons 0 "lwpolyline")) )) (command "_.erase" sshatch4 "") (setvar 'cmdecho 1) ) ) (princ) ) (defun ex:BMPSTEP1 ( / ) (princ "\n BMP Convert to Polyline - Place the bmp file in the same folder as this dwg file and run it.") (setq path (getvar 'dwgprefix)) (setq file (getfiled "Select BMP File" path "bmp" 16)) (setq lst (vlax-safearray->list (vlax-variant-value (LM:readbinarystream file 0)))) ;(princ "\n bitmap file - ") ;(princ file) (setq listlen (length lst)) ;(princ lst) (setq bitmapfileheader '()) (repeat 14 (setq b (car lst)) (setq bitmapfileheader (cons b bitmapfileheader)) (setq lst (cdr lst)) ) (setq bitmapfileheader (reverse bitmapfileheader)) ;(princ "\n bitmap file header - ") ;(princ bitmapfileheader) (setq bitmapinfoheader '()) (repeat 40 (setq c (car lst)) (setq bitmapinfoheader (cons c bitmapinfoheader)) (setq lst (cdr lst)) ) (setq bitmapinfoheader (reverse bitmapinfoheader)) ;(princ "\n bitmap info header - ") ;(princ bitmapinfoheader) ;(princ "\n bitmap data - ") ;(princ lst) (setq widtha (nth 4 bitmapinfoheader)) (setq widthb (* (nth 5 bitmapinfoheader) 256)) (setq widthc (* (nth 6 bitmapinfoheader) (* 256 256))) (setq widthd (* (nth 7 bitmapinfoheader) (* (* 256 256) 256))) (setq biwidth (+ (+ (+ widtha widthb) widthc) widthd)) (princ "\n bitmap width - ") (princ biwidth) (setq heighta (nth 8 bitmapinfoheader)) (setq heightb (* (nth 9 bitmapinfoheader) 256)) (setq heightc (* (nth 10 bitmapinfoheader) (* 256 256))) (setq heightd (* (nth 11 bitmapinfoheader) (* (* 256 256) 256))) (setq biheight (+ (+ (+ heighta heightb) heightc) heightd)) (princ " / height - ") (princ biheight) (setq bitmapbit (nth 14 bitmapinfoheader)) (cond ((= bitmapbit 24) (princ "\n it's 24 bit bmp file ")) ((= bitmapbit 32) (princ "\n it's 32 bit bmp file ")) ) (setq bitmapdata '()) (setq basept (getpoint "\n pick point for bmp (Lower Left Point) - ")) (setq baseptx (car basept)) (setq xreturn baseptx) (setq basepty (cadr basept)) (setq yreturn basepty) (setq ss (ssadd)) (setq exceptionyn (getstring "\n you want to except background color? [Y - yes / SpaceBar - no]")) (if (= (strcase exceptionyn) "Y") (progn (setq exceptionr (getint "\n input background's Red value : ")) (setq exceptiong (getint "\n input background's Green value : ")) (setq exceptionb (getint "\n input background's Blue value : ")) (setq exceptionrange (getint "\n input background's range (0~100%) : ")) (setq exceptionrange (/ (* exceptionrange 256) 100)) (setq exrmin (- exceptionr exceptionrange)) (if (< exrmin 0) (setq exrmin 0)) (setq exrmax (+ exceptionr exceptionrange)) (if (> exrmax 255) (setq exrmax 255)) (setq exgmin (- exceptiong exceptionrange)) (if (< exgmin 0) (setq exgmin 0)) (setq exgmax (+ exceptiong exceptionrange)) (if (> exgmax 255) (setq exgmax 255)) (setq exbmin (- exceptionb exceptionrange)) (if (< exbmin 0) (setq exbmin 0)) (setq exbmax (+ exceptionb exceptionrange)) (if (> exbmax 255) (setq exbmax 255)) ) ) (setq aciyn (getstring "\n Do you want to keep true color? [Y - yes / SpaceBar - no] : \n If you keep true color, the color is correct, but you need to modify the plot ctb settings.")) (cond ((= bitmapbit 24) (setq skipper (/ (- (length lst) (* (* biwidth 3) biheight)) biheight)) ) ((= bitmapbit 32) (setq skipper (/ (- (length lst) (* (* biwidth 4) biheight)) biheight)) ) ) ;(setq skipper (/ (- (length lst) (* (* biwidth 3) biheight)) biheight)) (if (> skipper 0) (progn (princ "\n If a bug that distorts the image occurs, try adjusting the skipper variable (Range 0 ~ ") (princ skipper) (princ "), default = 0 : ") (setq userskipper (getint)) (if (= userskipper nil) (setq userskipper 0)) (setq skipper (- skipper userskipper)) ) ) (princ "\n skipper - ") (princ skipper) (setq pixelstack '()) (repeat biheight (setq pixellist '()) (setq pixelrowstack '()) (repeat biwidth (setq pblue (car lst)) (setq pgreen (cadr lst)) (setq pred (caddr lst)) (if (= (strcase exceptionyn) "Y") (progn (if (<= exrmin pred) (progn (if (>= exrmax pred) (progn (if (<= exgmin pgreen) (progn (if (>= exgmax pgreen) (progn (if (<= exbmin pblue) (progn (if (>= exbmax pblue) (progn (if (= (strcase aciyn) "Y") (setq pixel 16777300) (setq pixel 999) ) ) (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pblue );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pblue );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pgreen );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pgreen );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pred );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if pred );end of progn (progn (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pred pgreen pblue)) (setq pixel (LM:RGB->ACI pred pgreen pblue)) ) ) );end of if (setq pixelrowstack (cons pixel pixelrowstack)) (cond ((= bitmapbit 24) (setq lst (cdddr lst)) ) ((= bitmapbit 32) (setq lst (cddddr lst)) ) ) ); end of repeat (setq pixelstack (cons (reverse pixelrowstack) pixelstack)) (repeat skipper (setq lst (cdr lst)) ) ) (setq pixelstack (reverse pixelstack)) ;(princ pixelstack) pixelstack ) (defun ex:BMPSTEP1GRAY ( / ) (princ "\n BMP Convert to Polyline - Place the bmp file in the same folder as this dwg file and run it.") (setq path (getvar 'dwgprefix)) (setq file (getfiled "Select BMP File" path "bmp" 16)) (setq lst (vlax-safearray->list (vlax-variant-value (LM:readbinarystream file 0)))) ;(princ "\n bitmap file - ") ;(princ file) (setq listlen (length lst)) ;(princ lst) (setq bitmapfileheader '()) (repeat 14 (setq b (car lst)) (setq bitmapfileheader (cons b bitmapfileheader)) (setq lst (cdr lst)) ) (setq bitmapfileheader (reverse bitmapfileheader)) ;(princ "\n bitmap file header - ") ;(princ bitmapfileheader) (setq bitmapinfoheader '()) (repeat 40 (setq c (car lst)) (setq bitmapinfoheader (cons c bitmapinfoheader)) (setq lst (cdr lst)) ) (setq bitmapinfoheader (reverse bitmapinfoheader)) ;(princ "\n bitmap info header - ") ;(princ bitmapinfoheader) ;(princ "\n bitmap data - ") ;(princ lst) (setq widtha (nth 4 bitmapinfoheader)) (setq widthb (* (nth 5 bitmapinfoheader) 256)) (setq widthc (* (nth 6 bitmapinfoheader) (* 256 256))) (setq widthd (* (nth 7 bitmapinfoheader) (* (* 256 256) 256))) (setq biwidth (+ (+ (+ widtha widthb) widthc) widthd)) (princ "\n bitmap width - ") (princ biwidth) (setq heighta (nth 8 bitmapinfoheader)) (setq heightb (* (nth 9 bitmapinfoheader) 256)) (setq heightc (* (nth 10 bitmapinfoheader) (* 256 256))) (setq heightd (* (nth 11 bitmapinfoheader) (* (* 256 256) 256))) (setq biheight (+ (+ (+ heighta heightb) heightc) heightd)) (princ " / height - ") (princ biheight) (setq bitmapbit (nth 14 bitmapinfoheader)) (cond ((= bitmapbit 24) (princ "\n it's 24 bit bmp file ")) ((= bitmapbit 32) (princ "\n it's 32 bit bmp file ")) ) (setq bitmapdata '()) (setq basept (getpoint "\n pick point for bmp (Lower Left Point) - ")) (setq baseptx (car basept)) (setq xreturn baseptx) (setq basepty (cadr basept)) (setq ss (ssadd)) (setq exceptionyn (getstring "\n you want to except background color? [Y - yes / SpaceBar - no]")) (if (= (strcase exceptionyn) "Y") (progn (setq exceptionr (getint "\n input background's Red value : ")) (setq exceptiong (getint "\n input background's Green value : ")) (setq exceptionb (getint "\n input background's Blue value : ")) (setq exceptionrange (getint "\n input background's range (0~100%) : ")) (setq exceptionrange (/ (* exceptionrange 256) 100)) (setq exrmin (- exceptionr exceptionrange)) (if (< exrmin 0) (setq exrmin 0)) (setq exrmax (+ exceptionr exceptionrange)) (if (> exrmax 255) (setq exrmax 255)) (setq exgmin (- exceptiong exceptionrange)) (if (< exgmin 0) (setq exgmin 0)) (setq exgmax (+ exceptiong exceptionrange)) (if (> exgmax 255) (setq exgmax 255)) (setq exbmin (- exceptionb exceptionrange)) (if (< exbmin 0) (setq exbmin 0)) (setq exbmax (+ exceptionb exceptionrange)) (if (> exbmax 255) (setq exbmax 255)) ) ) (setq aciyn (getstring "\n Do you want to keep true color? [Y - yes / SpaceBar - no] : \n If you keep true color, the color is correct, but you need to modify the plot ctb settings.")) (cond ((= bitmapbit 24) (setq skipper (/ (- (length lst) (* (* biwidth 3) biheight)) biheight)) ) ((= bitmapbit 32) (setq skipper (/ (- (length lst) (* (* biwidth 4) biheight)) biheight)) ) ) ;(setq skipper (/ (- (length lst) (* (* biwidth 3) biheight)) biheight)) (if (> skipper 0) (progn (princ "\n If a bug that distorts the image occurs, try adjusting the skipper variable (Range 0 ~ ") (princ skipper) (princ "), default = 0 : ") (setq userskipper (getint)) (if (= userskipper nil) (setq userskipper 0)) (setq skipper (- skipper userskipper)) ) ) (princ "\n skipper - ") (princ skipper) (setq pixelstack '()) (repeat biheight (setq pixellist '()) (setq pixelrowstack '()) (repeat biwidth (setq pblue (car lst)) (setq pgreen (cadr lst)) (setq pred (caddr lst)) (if (= (strcase exceptionyn) "Y") (progn (if (<= exrmin pred) (progn (if (>= exrmax pred) (progn (if (<= exgmin pgreen) (progn (if (>= exgmax pgreen) (progn (if (<= exbmin pblue) (progn (if (>= exbmax pblue) (progn (if (= (strcase aciyn) "Y") (setq pixel 16777300) (setq pixel 999) ) ) (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pblue );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pblue );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pgreen );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pgreen );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pred );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if pred );end of progn (progn (setq pgray (+ (+ (* pred 0.299) (* pgreen 0.587)) (* pblue 0.114))) (if (= (strcase aciyn) "Y") (setq pixel (LM:RGB->True pgray pgray pgray)) (setq pixel (LM:RGB->ACI pgray pgray pgray)) ) ) );end of if (setq pixelrowstack (cons pixel pixelrowstack)) (cond ((= bitmapbit 24) (setq lst (cdddr lst)) ) ((= bitmapbit 32) (setq lst (cddddr lst)) ) ) ); end of repeat (setq pixelstack (cons (reverse pixelrowstack) pixelstack)) (repeat skipper (setq lst (cdr lst)) ) ) (setq pixelstack (reverse pixelstack)) ;(princ pixelstack) pixelstack ) (defun c:mffm ( / ) (setq a (list (list 1 2 3 4) (list 5 6 7 8))) (setq no 0) (setq b (ex:MakeFrameForMatrix a no)) (princ b) (princ) ) (defun ex:MakeFrameForMatrix ( lst frameno / verticallen horizontallen 1row index original1row ) (setq verticallen (length lst)) (setq horizontallen (length (car lst))) (setq newmatrix '()) (setq 1row '()) (repeat horizontallen (setq 1row (cons frameno 1row)) ) (setq newmatrix (cons 1row newmatrix)) (setq index 0) (repeat verticallen (setq original1row (nth index lst)) (setq original1row (cons frameno original1row)) (setq original1row (cons frameno (reverse original1row))) (setq original1row (reverse original1row)) (setq newmatrix (cons original1row newmatrix)) (setq index (+ index 1)) ) (setq newmatrix (cons 1row newmatrix)) (setq newmatrix (reverse newmatrix)) newmatrix ) ;; RGB -> ACI - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->ACI ( r g b / c o ) (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (progn (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o)))) (vlax-release-object o) (if (vl-catch-all-error-p c) (prompt (strcat "\nError: " (vl-catch-all-error-message c))) c ) ) ) ) ;; RGB -> True - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->True ( r g b ) (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b)) ) ;; True -> RGB - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)) ) ;; True -> ACI - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->ACI ( c / o r ) (apply 'LM:RGB->ACI (LM:True->RGB c)) ) ;; Application Object - Lee Mac ;; Returns the VLA Application Object (defun LM:acapp nil (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object))) (LM:acapp) ) ;;-----------------=={ Read Binary Stream }==-----------------;; ;; ;; ;; Uses the ADO Stream Object to read a supplied file and ;; ;; returns a variant of bytes. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; filename - filename of file to read. ;; ;; len - number of bytes to read ;; ;; (if non-numerical, less than 1, or greater than the size ;; ;; of the file, everything is returned). ;; ;;------------------------------------------------------------;; ;; Returns: ;; ;; Variant of Binary data which may be converted to a list ;; ;; bytes using the relevant VL Variant functions or used ;; ;; with LM:WriteBinaryStream. ;; ;;------------------------------------------------------------;; (defun LM:ReadBinaryStream ( filename len / ADOStream result ) (setq result (vl-catch-all-apply (function (lambda ( / size ) (setq ADOStream (vlax-create-object "ADODB.Stream")) (vlax-invoke ADOStream 'Open) (vlax-put-property ADOStream 'type 1) (vlax-invoke-method ADOStream 'loadfromfile filename) (vlax-put-property ADOStream 'position 0) (setq size (vlax-get ADOStream 'size)) (vlax-invoke-method ADOStream 'read (if (and (numberp len) (< 0 len size)) (fix len) -1)) ) ) ) ) (if ADOStream (vlax-release-object ADOStream)) (if (not (vl-catch-all-error-p result)) result ) ) command : BMP, BMP2 Placing the bmp file in the same folder as the drawing is easier to avoid errors. - BMP updated version of BMP2, make 1 line horizontal if pixel has same color. this will compress the capacity. - BMP2 old version, 1 length x 1 width polyline mosaic. when to use - when you do not want to IMAGEATTACH - when you do not want to use a convenient site that converts dxf or dwg - when you want to increase the drawing capacity more than necessary - when it is not possible to use the convenient raster tool of AutoCAD because it is an alternative cad this lisp creates a polyline of 1 length and 1 width like a mosaic or 1 width horizontal polyline. It can be convenient when you put a simple signature of 300x300 or less. you can remove 1 background color by entering red, green, and blue numbers. ex) 255,255,255 = white and now can set range of exception (0~100%) top : 255, 255, 255, 0% (aci color, 2533 lines) middle : 255, 255, 255, 10% (aci color, 1945 lines) bottom : 255, 255, 255, 30% (aci color, 761 lines) note - If a bug that distorts the image occurs, try adjusting the skipper variable - Because true color is used, the same rules as monochrome may not apply when plotting with ctb. to change plot style you need to use stb or change to similar indexed color. -> (latest update) add option for true color or aci color top : aci color, 2387 lines bottom : true color, 5052 lines Although I said under 300x300 is recommended However, it is not impossible to exceed that size. This is a 1920x1080 size windows XP wallpaper created with 460,000 lines over 30 minutes (by aci color) update 2022.05.12 - fix exception range % the speed decreased because r, g, b 3 values were compared. If I compare this sequentially in r, g, b order with 3 ifs. the colors that fall out first will appear, so the speed may increase. I think. -> updated in latest code update 2022.05.17 - edit skipper variable calculation - more bmp files supported without errors. except for the first 54 member headers in the bmp binary, the rest have values of r, g, and b, at the end of each line, a dummy value other than the r, g, and b values may or may not be included, it is different for each bmp file. skipper variable remove this. (It may be a carriage return or line feed of a text file. i guess) I initially mistakenly thought that this value would also 3 pairs, like r, g, and b., But it wasn't. So I edit it. - support 32-bit bmp file also, but alpha channel is not used for polyline expression. this option may be good to use in many cases, because almost of image editing programs or sites, or capture programs often use 32-bit bmp files. - add BMP1 command - grayscale calculation automatically input every r, g, b value as red * 0.299 + green * 0.587 + blue * 0.114. Calculate based on rgb values. Some colors may become non-grey during conversion to aci. - add BMP3 command - temporary step for making hatches In the case of hatches, I found that creating borders with dot-by-dot like now would be slower than polylines. For a line it is a start and end point of 2 points, but for a hatch there should be 4 points. Therefore, we need a way to make it a little simpler. And like the current outline method, if all four directions are the same color, if I delete it from the list, I will not know where to fill in the donut problem. I have to find a new way. It may be better to settle for the polyline method. So I'm going to pause this in version 2 for a while. haha update 2022.05.18 - edit BMP3 command - this will make hatch with simple vertex. but it is not completed routine. Edited May 18, 2022 by exceed 5 Quote
Emmanuel Delay Posted May 11, 2022 Posted May 11, 2022 (edited) Right. Bitmap in uncompressed; basically a continuous list of RGB values for every pixel. This is useful to make dwg version of logos. I'll certainly test it EDIT: A possible plugin (that I'll write maybe): Reduce similar colors to a set list of colors. The user types in a list of colors with set RGB value. For example dark white (247,247,247); blue (17,102,232); green (247,60,46) ... Or those colors are read from the color of the layers in the dwg. Then for every pixel a function searches which of the set colors is closest to that pixel's color. ... Then you finish (let's take your Google logo example) with just 5 colors. Edited May 11, 2022 by Emmanuel Delay 1 Quote
exceed Posted May 11, 2022 Author Posted May 11, 2022 (edited) 18 hours ago, Emmanuel Delay said: EDIT: A possible plugin (that I'll write maybe): Reduce similar colors to a set list of colors. The user types in a list of colors with set RGB value. For example dark white (247,247,247); blue (17,102,232); green (247,60,46) ... Or those colors are read from the color of the layers in the dwg. Then for every pixel a function searches which of the set colors is closest to that pixel's color. ... Then you finish (let's take your Google logo example) with just 5 colors. it seems interesting, like this way? https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/routine-to-change-rgb-colors-to-aci-index-255-colors-and-the/m-p/6230142/highlight/true#M339953 or more simplify it, not only ACI converting. since ACI is not a sequential arrangement of colors, make groups in truecolor state and then average them, and then use Lee Mac's transformation. it seems good + there's 2 problem in my lisp 1. truecolor also not continuous. because that is sum of red x 256 x 256, green x 256, blue. blue value get more effect by percent calculation. in example, [red 1, green 1, blue 1] and [red 1, green 1, blue 255] is under 1% range in true color numbers. but that's not similrar color. so have to calculate exception color range by r, g, b each 3 values. i forgot that when i wrote this. -> updated in latest code 2022.05.12 2. also have to do aci conversion before make it true color. this make more compressed polyline. because duplication level is different in truecolor and aci 256 color. 256 color can have more compact polyline. so have to move cond to front of code. and then when it in exception range make it 300 or something to know that it's skip value. -> updated in latest code 2022.05.12 and 1 thing to improve since finding the horizontal similar color was success, and next, find the vertical similar color using the rotate matrix written in 2048 post. After that, an area connecting the borders of each color is created. Then fill the closed polyline with a solid hatch. Also, smoothing the vertices of the polyline before filling seems to give better results. i think i don't have enough time today. haha Edited May 12, 2022 by exceed 1 Quote
exceed Posted May 19, 2022 Author Posted May 19, 2022 (edited) ; BMPEXCEL - 2022.05.19 exceed ; BMP file -> Excel Cell Background Color. like ASCII ART. ; ; Since BMP files are converted to EXCEL files, there is no need to use AutoCAD in fact. ; However, this is an extra version of Lisp that turns BMP files into polylines. and I just made it for fun. ; ; Command ; > BMPEXCEL ; ; Note ; > To stop while working : click any cell in Excel, or move the Excel window ; > Because Excel has a small number of columns, the width of the BMP must be smaller than that. (1 pixel = 1 cell) ; this takes a long time, so 100x50 is recommended for testing. ; > 24-bit or 32-bit BMP file is supported. not 16-bit, 256color, 16color, Black&White. (defun c:BMPEXCEL ( / r c pixelstack *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3 r c pixelstack pxslen pxsrow pxsrowlen pxscell xreturn yreturn ) (setq pixelstack (reverse (ex:BMPSTEP1))) (setq pxslen (length pixelstack)) (ex:ESMAKE) (vlax-put-property xlcols 'ColumnWidth 0.77) (vlax-put-property xlrows 'RowHeight 7.5) (repeat pxslen (setq pxsrow (car pixelstack)) (setq pxsrowlen (length pxsrow)) (repeat pxsrowlen (setq pxscell (car pxsrow)) (if (/= pxscell 16777300) (progn (ex:eccolor r c pxscell) );end of progn (progn ) );end of if (setq c (+ c 1)) (setq pxsrow (cdr pxsrow)) );end of repeat (setq c xreturn) (setq r (+ r 1)) (setq pixelstack (cdr pixelstack)) );end of repeat (ex:releaseExcel) (princ) ) (defun ex:ESMAKE ( ) ;from BIGAL's ah:chkexcel (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq xlcols (vlax-get-property acsheet 'Columns)) (setq xlrows (vlax-get-property acsheet 'Rows)) (setq cell (vlax-get-property acsheet 'Cells)) ) (defun ex:ECCOLOR ( r c truecolor ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) ;(princ "c1 - ") ;(princ c1) ;(princ "c2 - ") ;(princ c2) (if (> c2 0) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) ) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) ;(princ "c1 - ") ;(princ c1) ;(princ "c2 - ") ;(princ c2) ;(princ "c3 - ") ;(princ c3) (if (> c3 0) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) ) );end of cond option 3 );end of cond ;(princ addr) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-put-property (vlax-get-property rng "Interior") "Color" (vlax-make-variant truecolor)) (vlax-invoke rng 'Select) ) (defun ex:BMPSTEP1 ( / ) (setq path (getvar 'dwgprefix)) (setq file (getfiled "Select BMP File" path "bmp" 16)) (setq lst (vlax-safearray->list (vlax-variant-value (LM:readbinarystream file 0)))) (setq listlen (length lst)) (setq bitmapfileheader '()) (repeat 14 (setq b (car lst)) (setq bitmapfileheader (cons b bitmapfileheader)) (setq lst (cdr lst)) ) (setq bitmapfileheader (reverse bitmapfileheader)) (setq bitmapinfoheader '()) (repeat 40 (setq c (car lst)) (setq bitmapinfoheader (cons c bitmapinfoheader)) (setq lst (cdr lst)) ) (setq bitmapinfoheader (reverse bitmapinfoheader)) (setq widtha (nth 4 bitmapinfoheader)) (setq widthb (* (nth 5 bitmapinfoheader) 256)) (setq widthc (* (nth 6 bitmapinfoheader) (* 256 256))) (setq widthd (* (nth 7 bitmapinfoheader) (* (* 256 256) 256))) (setq biwidth (+ (+ (+ widtha widthb) widthc) widthd)) (princ "\n bitmap width - ") (princ biwidth) (setq heighta (nth 8 bitmapinfoheader)) (setq heightb (* (nth 9 bitmapinfoheader) 256)) (setq heightc (* (nth 10 bitmapinfoheader) (* 256 256))) (setq heightd (* (nth 11 bitmapinfoheader) (* (* 256 256) 256))) (setq biheight (+ (+ (+ heighta heightb) heightc) heightd)) (princ " / height - ") (princ biheight) (setq bitmapbit (nth 14 bitmapinfoheader)) (cond ((= bitmapbit 24) (princ "\n it's 24 bit bmp file ")) ((= bitmapbit 32) (princ "\n it's 32 bit bmp file ")) ) (setq bitmapdata '()) ;(setq basept (getpoint "\n pick point for bmp (Lower Left Point) - ")) (setq r 2) (setq xreturn r) (setq c 2) (setq yreturn c) ;(setq ss (ssadd)) (setq exceptionyn (getstring "\n you want to except background color? [Y - yes / SpaceBar - no]")) (if (= (strcase exceptionyn) "Y") (progn (setq exceptionr (getint "\n input background's Red value : ")) (setq exceptiong (getint "\n input background's Green value : ")) (setq exceptionb (getint "\n input background's Blue value : ")) (setq exceptionrange (getint "\n input background's range (0~100%) : ")) (setq exceptionrange (/ (* exceptionrange 256) 100)) (setq exrmin (- exceptionr exceptionrange)) (if (< exrmin 0) (setq exrmin 0)) (setq exrmax (+ exceptionr exceptionrange)) (if (> exrmax 255) (setq exrmax 255)) (setq exgmin (- exceptiong exceptionrange)) (if (< exgmin 0) (setq exgmin 0)) (setq exgmax (+ exceptiong exceptionrange)) (if (> exgmax 255) (setq exgmax 255)) (setq exbmin (- exceptionb exceptionrange)) (if (< exbmin 0) (setq exbmin 0)) (setq exbmax (+ exceptionb exceptionrange)) (if (> exbmax 255) (setq exbmax 255)) ) ) (cond ((= bitmapbit 24) (setq skipper (/ (- (length lst) (* (* biwidth 3) biheight)) biheight)) ) ((= bitmapbit 32) (setq skipper (/ (- (length lst) (* (* biwidth 4) biheight)) biheight)) ) ) (if (> skipper 0) (progn (princ "\n If a bug that distorts the image occurs, try adjusting the skipper variable (Range 0 ~ ") (princ skipper) (princ "), default = 0 : ") (setq userskipper (getint)) (if (= userskipper nil) (setq userskipper 0)) (setq skipper (- skipper userskipper)) ) ) (princ "\n skipper - ") (princ skipper) (setq pixelstack '()) (repeat biheight (setq pixellist '()) (setq pixelrowstack '()) (repeat biwidth (setq pblue (car lst)) (setq pgreen (cadr lst)) (setq pred (caddr lst)) (if (= (strcase exceptionyn) "Y") (progn (if (<= exrmin pred) (progn (if (>= exrmax pred) (progn (if (<= exgmin pgreen) (progn (if (>= exgmax pgreen) (progn (if (<= exbmin pblue) (progn (if (>= exbmax pblue) (progn (setq pixel 16777300) ) (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pblue );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pblue );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pgreen );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pgreen );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pred );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if pred );end of progn (progn (setq pixel (LM:RGB->Trueexcel pred pgreen pblue)) ) );end of if (setq pixelrowstack (cons pixel pixelrowstack)) (cond ((= bitmapbit 24) (setq lst (cdddr lst)) ) ((= bitmapbit 32) (setq lst (cddddr lst)) ) ) ); end of repeat (setq pixelstack (cons (reverse pixelrowstack) pixelstack)) (repeat skipper (setq lst (cdr lst)) ) ) (setq pixelstack (reverse pixelstack)) ;(princ pixelstack) pixelstack ) ;; RGB -> True - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->Trueexcel ( b g r ) (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b)) ) I separated this, because this is not related to main work. converting BMP file to Excel Cell Background Color. like ASCII ART. Since BMP files are converted to EXCEL files, there is no need to use CAD in fact. but this is an extra version of Lisp that turns BMP files into polylines. through this i learned how to paint excel cell background color with True color. (I was use only colorindex. before) the curious thing is, when calculating true colors, it was the order of r,g,b in CAD, but the order of b,g,r in EXCEL. I don't know why... Edited May 19, 2022 by exceed 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.