;;;Commands DEFUN'd: ;;; HIDEPREP (or IMGPREP) initializes attachment of image 1X1.BMP to enable its use. Okay to delete the image occurence from this. ;;; HIDEDONUT (or IMGDONUT) creates a donut shaped clipped instance of 1x1.bmp. ;;; HIDEARC (or IMGARC) creates an arc shaped clipped instance of 1x1.bmp ;;; HIDEBDRY creates a new instance of 1x1.bmp and clips it along the selected polyline boundary (arc segments are okay). ;;; CLIPIMAGE clips an existing instance of any image to a selected polyline boundary. ;;; (Boundary should lie within the image for best results, arc segments are NOT followed, see note below) ;;; ;;; Note: PLXL.LSP (command: PLXL) will convert polylines with arcs into polylines with multiple straight segments whose vertices lie on the original arc. ;;; A small user specified deflection angle (5° or less) will produce segments that approximate the appearance of the original arc. ;;; Using PLXL allows easy preparation of a polyline for clipping an image using a polyline that had contained arc segments. ;;; If the arc segments remain in the polyline boundary the resulting image clip boundary will lie straight along the chords of the arcs. ;;; HIDE... commands handle arcs in polylines internally. ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 2004 ;;; Edited: 6-17-2010 ;;; ;;; ;;;**************************************************************************** (DEFUN C:HIDEPREP () (SETQ old_osmode (GETVAR "osmode")) (SETVAR "osmode" 0) (IF (OR (SSGET "x" '((0 . "image") (2 . "1x1"))) (FINDFILE "1x1.bmp") ) ;_ end of or (PROGN (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of if (SETQ imginspt (upoint 1 "" "Image lower left corner" nil nil)) (SETQ imgbrc (upoint 1 "" "Width of image base" nil imginspt)) (SETQ imgsize (DISTANCE imginspt (LIST (CAR imgbrc) (CADR imginspt) 0) ) ;_ end of distance ) ;_ end of setq (COMMAND ".image" "a" "1x1" imginspt (* 72.0 imgsize) 0 ) ;_ end of command (SETQ imgent (ENTGET (ENTLAST))) ;;; (ALERT ;;; (STRCAT ;;; "\nYou must IMAGECLIP (POLYGONAL) this image before proceding." ;;; "\nOtherwise the image will blank out displaying its frame only." ;;; "\nIMAGECLIP / POLYGONAL is automatically started with this image." ;;; "\nUse at least 3 boundary points then run IMGARC on the image." ;;; "\nIMGARC will resize and reposition the image with your arc or circle.") ;_ end of strcat ;;; ) ;_ end of alert ;;; (COMMAND ".imageframe" "on") ;;; (COMMAND ".imageclip" (ENTLAST) "New" "Polygonal") (PRINC) ) ;_ end of progn (PRINC "\nUnable to locate image 1x1.bmp. Make sure it exists and is on AutoCAD's support file search path. " ) ;_ end of princ ) ;_ end of if (SETVAR "osmode" old_osmode) (PRINC) ) ;_ end of defun (DEFUN c:imgprep () (C:HIDEPREP)) ;;;**************************************************************************** (DEFUN C:HIDEDONUT () (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of if (IF uangle nil (LOAD "uangle" "\nFile UREAL.LSP not loaded! ") ) ;_ end of if (IF ureal nil (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of if (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of if (WHILE (AND (SETQ arcoent (ENTSEL "Select arc or circle (outside edge)")) (NOT (OR (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "ARC") (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "CIRCLE") ) ;_ end of or ) ;_ end of not ) ;_ end of and ) ;_ end of while (SETQ arccenpnt (CDR (ASSOC 10 (ENTGET (CAR arcoent)))) arcradval (CDR (ASSOC 40 (ENTGET (CAR arcoent)))) ) ;_ end of setq (PRINC "Arc radius is ") (PRINC arcradval) (PRINC) (IF (NOT (FINDFILE "1x1.bmp")) (ALERT "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again." ) ;_ end of alert (PROGN (COMMAND ".image" "a" "1x1" arccenpnt 1 0) (SETQ imgent (ENTGET (ENTLAST))) (SETQ imgoradpt nil) (SETQ imgorad arcradval) (SETQ imgsang 0) (SETQ imgeang (* 2.0 PI)) (SETQ pntcnt 5) (SETQ imgiradpt nil) (WHILE (OR (NOT imgiradpt) (>= imgirad imgorad)) (SETQ imgiradpt (upoint 1 "" "Image donut inside radius" nil arccenpnt ) ;_ end of upoint ;_ end of upoint ;_ end of upoint ;_ end of upoint ;_ end of upoint ) ;_ end of setq (SETQ imgirad (DISTANCE (REVERSE (CDR (REVERSE arccenpnt))) (REVERSE (CDR (REVERSE imgiradpt))) ) ;_ end of distance ) ;_ end of setq ) ;_ end of while (SETQ angsure nil) (WHILE (NOT (AND (SETQ cntincr (ureal 1 "" "Angle increment for image clip boundary" pntcnt ) ;_ end of ureal ) ;_ end of setq (IF (< cntincr pntcnt) (PROGN (SETQ angsure (ukword 1 "Yes No" (STRCAT "Using and angle increment of " (RTOS cntincr 2 4) " may take awhile. Are you sure?" ) ;_ end of strcat "No" ) ;_ end of ukword ) ;_ end of setq (IF (EQ angsure "No") nil T ) ;_ end of if ) ;_ end of progn T ) ;_ end of if ) ;_ end of and ) ;_ end of not ) ;_ end of while (SETQ x11 (* (COS imgsang) (* 2.0 arcradval)) y11 (* (SIN imgsang) (* 2.0 arcradval)) x12 (* (COS (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval)) y12 (* (SIN (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval)) imgctr (POLAR arccenpnt (+ imgsang (* 1.25 PI)) (/ arcradval (COS (* 0.25 PI))) ) ;_ end of polar assoc10 (CONS 10 imgctr) assoc11 (CONS 11 (LIST x11 y11 0.0)) assoc12 (CONS 12 (LIST x12 y12 0.0)) imgent (SUBST assoc10 (ASSOC 10 imgent) imgent) imgent (SUBST assoc11 (ASSOC 11 imgent) imgent) imgent (SUBST assoc12 (ASSOC 12 imgent) imgent) ) ;_ end of setq (ENTMOD imgent) (SETQ imgsang 0) (imgarcclp imgent imgeang imgorad imgirad cntincr) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun (DEFUN c:imgdonut () (C:HIDEDONUT)) ;;;**************************************************************************** (DEFUN C:HIDEARC () (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of if (IF uangle nil (LOAD "uangle" "\nFile UREAL.LSP not loaded! ") ) ;_ end of if (IF ureal nil (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of if (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of if (WHILE (AND (SETQ arcoent (ENTSEL "Select arc or circle (outside edge)")) (NOT (OR (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "ARC") (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "CIRCLE") ) ;_ end of or ) ;_ end of not ) ;_ end of and ) ;_ end of while (SETQ arccenpnt (CDR (ASSOC 10 (ENTGET (CAR arcoent)))) arcradval (CDR (ASSOC 40 (ENTGET (CAR arcoent)))) ) ;_ end of setq (PRINC "Arc radius is ") (PRINC arcradval) (PRINC) (IF (NOT (FINDFILE "1x1.bmp")) (ALERT "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again." ) ;_ end of alert (PROGN (COMMAND ".image" "a" "1x1" arccenpnt 1 0) (SETQ imgent (ENTGET (ENTLAST))) (SETQ imgoradpt nil) (SETQ imgorad arcradval) (WHILE (NOT imgoradpt) (SETQ imgoradpt (upoint 1 "" "Image start angle" nil arccenpnt)) (SETQ imgsang (ANGLE (REVERSE (CDR (REVERSE arccenpnt))) (REVERSE (CDR (REVERSE imgoradpt))) ) ;_ end of angle ) ;_ end of setq ) ;_ end of while (SETQ imgiradpt nil) (WHILE (OR (NOT imgiradpt) (>= imgirad imgorad)) (SETQ imgiradpt (upoint 1 "" "Image inside radius and end angle" nil arccenpnt ) ;_ end of upoint ;_ end of upoint ;_ end of upoint ;_ end of upoint ;_ end of upoint ) ;_ end of setq (SETQ imgirad (DISTANCE (REVERSE (CDR (REVERSE arccenpnt))) (REVERSE (CDR (REVERSE imgiradpt))) ) ;_ end of distance ) ;_ end of setq ) ;_ end of while (SETQ raweang (ANGLE (REVERSE (CDR (REVERSE arccenpnt))) (REVERSE (CDR (REVERSE imgiradpt))) ) ;_ end of angle ) ;_ end of setq (IF (< raweang imgsang) (SETQ raweang (+ raweang (* 2.0 PI))) ) ;_ end of if (SETQ imgeang (- raweang imgsang)) (IF (OR (EQUAL (ABS imgeang) 0 0.00001) (EQUAL (ABS imgeang) (* 2.0 PI) 0.00001) ) ;_ end of or (PROGN (SETQ imgeang (* 2.0 PI)) (PRINC "\nImage angle set to 360°. ") (PRINC "\n0° is invalid. Key-in near values to achieve proximate results. " ) ;_ end of princ ) ;_ end of progn (PRINC (STRCAT "\nImage angle of " (RTOS (* (/ imgeang (* 2.0 PI)) 360.0) 2 4) "° applied. " ) ;_ end of strcat ) ;_ end of princ ) ;_ end of if (SETQ pntcnt (/ (* 2.0 (* 180.0 (/ imgeang PI))) 45.0)) (SETQ angsure nil) (WHILE (NOT (AND (SETQ cntincr (ureal 1 "" "Angle increment for image clip boundary" pntcnt ) ;_ end of ureal ) ;_ end of setq (IF (< cntincr pntcnt) (PROGN (SETQ angsure (ukword 1 "Yes No" (STRCAT "Using and angle increment of " (RTOS cntincr 2 4) " may take awhile. Are you sure?" ) ;_ end of strcat "No" ) ;_ end of ukword ) ;_ end of setq (IF (EQ angsure "No") nil T ) ;_ end of if ) ;_ end of progn T ) ;_ end of if ) ;_ end of and ) ;_ end of not ) ;_ end of while (PRINC) (SETQ x11 (* (COS imgsang) (* 2.0 arcradval)) y11 (* (SIN imgsang) (* 2.0 arcradval)) x12 (* (COS (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval)) y12 (* (SIN (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval)) imgctr (POLAR arccenpnt (+ imgsang (* 1.25 PI)) (/ arcradval (COS (* 0.25 PI))) ) ;_ end of polar assoc10 (CONS 10 imgctr) assoc11 (CONS 11 (LIST x11 y11 0.0)) assoc12 (CONS 12 (LIST x12 y12 0.0)) imgent (SUBST assoc10 (ASSOC 10 imgent) imgent) imgent (SUBST assoc11 (ASSOC 11 imgent) imgent) imgent (SUBST assoc12 (ASSOC 12 imgent) imgent) ) ;_ end of setq (ENTMOD imgent) (SETQ imgsang 0) (imgarcclp imgent imgeang imgorad imgirad cntincr) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun (DEFUN c:imgarc () (C:HIDEARC)) ;;;**************************************************************************** (DEFUN imgarcclp (imgent imgeang imgorad imgirad cntincr /) (SETQ imgbase (REVERSE (MEMBER (ASSOC 91 imgent) (REVERSE imgent)))) (SETQ imgclplst nil) (SETQ cpt (LIST 0.0 0.0 0.0)) (SETQ cnt 0) (SETQ interpt (POLAR cpt imgsang 0.5)) (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) (WHILE (< cnt (* 180.0 (/ imgeang PI))) (SETQ interpt (POLAR cpt (* (/ cnt 180.0) PI) 0.5)) (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) (SETQ cnt (+ cnt cntincr)) ) ;_ end of while (SETQ interpt (POLAR cpt imgeang 0.5)) (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) (IF (EQ imgirad 0) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 cpt)))) (PROGN (SETQ cnt (- cnt cntincr)) (SETQ interpt (POLAR cpt imgeang (* (/ imgirad imgorad) 0.5))) (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) (WHILE (> cnt 0) (SETQ interpt (POLAR cpt (* (/ cnt 180.0) PI) (* (/ imgirad imgorad) 0.5) ) ;_ end of polar ) ;_ end of setq (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) (SETQ cnt (- cnt cntincr)) ) ;_ end of while (SETQ interpt (POLAR cpt 0 (* (/ imgirad imgorad) 0.5))) (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0)) (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt)))) ) ;_ end of progn ) ;_ end of if (SETQ imgclplst (APPEND imgclplst (LIST (CAR imgclplst)))) (SETQ imgedef (APPEND imgbase imgclplst)) (SETQ img70 (ASSOC 70 imgedef)) (IF (EQ (BOOLE 1 (CDR img70) 4) 4) nil (SETQ imgedef (SUBST (CONS 70 (+ (CDR img70) 4)) img70 imgedef)) ) ;_ end of if (SETQ imgedef (SUBST (CONS 71 2) (ASSOC 71 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (SETQ imgedef (SUBST (CONS 91 (LENGTH imgclplst)) (ASSOC 91 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (SETQ imgedef (SUBST (CONS 280 1) (ASSOC 280 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (ENTMOD imgedef) (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN C:HIDEBDRY (/ found plvert_list pliness plinesslen sscount plent plvert strt40 end41 fpt1 fpt2 chrdl theta psi phi chang arcr arcc count plwinc plwe plwb incra incrn initang tinobjs ssitem pliness-cnt plobjs pliness-cnt border 3dpolyobj 3dplpts newpts tincnt tinobj delplobjs delcnt ptcnt ) (SETQ usrdeg 5.0) (IF bendpliness (SETQ pliness bendpliness) (PROGN (PRINC "\nSelect polylines or AECC TIN Surfaces ") (PRINC) (SETQ pliness (SSGET '((-4 . ""))));will hide under surface border if a surface is selected ) ) ;_ end of IF (SETQ pliness-cnt 0) (WHILE (< pliness-cnt (SSLENGTH pliness)) (SETQ ssitem (SSNAME pliness pliness-cnt)) (IF (EQ (CDR (ASSOC 0 (ENTGET ssitem))) "AECC_TIN_SURFACE") (PROGN (VL-LOAD-COM) (IF tinobjs NIL (SETQ tinobjs (SSADD)) ) (SETQ tinobjs (SSADD ssitem tinobjs)) ) (PROGN (IF plobjs NIL (SETQ plobjs (SSADD)) ) (SETQ plobjs (SSADD ssitem plobjs)) ) ) (SETQ pliness-cnt (1+ pliness-cnt)) ) (IF tinobjs (PROGN (SETQ tincnt 0) (WHILE (< tincnt (SSLENGTH tinobjs)) (SETQ tinobj (vlax-ename->vla-object (SSNAME tinobjs tincnt))) (SETQ border (vlax-invoke-method tinobj 'ExtractBorder 1));extract the surface border (SETQ 3dpolyobj (CAR (vlax-safearray->list (vlax-variant-value border))));get the 3D polyline object, (vlax-safearray->list ...) is easiest method I found. (SETQ 3dplpts (VLAX-GET 3dpolyobj 'Coordinates));get the 3D polyline coordinates list (these return in raw list form and not as point triplets). (SETQ newpts NIL ptcnt 1 ) (FOREACH n 3dplpts ;reconstruct the raw coordinates list with all Z-values = 0.0 (IF (EQ(REM ptcnt 3)0) (SETQ newpts (APPEND newpts (LIST 0.0)));replace Z-values with 0.0 (every third number in the raw list is a Z-value) (SETQ newpts (APPEND newpts (LIST n))) ) (SETQ ptcnt (1+ ptcnt)) ) (IF (EQUAL (LIST (CAR newpts)(CADR newpts)(CADDR newpts))(LIST (CADDR (REVERSE newpts))(CADR (REVERSE newpts))(CAR (REVERSE newpts)))) (SETQ newpts (REVERSE (CDR (MEMBER (CAR newpts) (REVERSE newpts)))));eliminate end point if it is the same as the start point. ) (ENTMAKE ;create the polyline header (LIST (CONS 0 "POLYLINE") (CONS 8 "2D-POLYLINE") (CONS 10 (LIST (CAR newpts)(CADR newpts)(CADDR newpts))) ) ;_ end of LIST ) ;_ end of ENTMAKE (SETQ usedpts_lst NIL) (WHILE (>= (LENGTH newpts) 3);create all polyline vertices (ENTMAKE (LIST (CONS 0 "VERTEX") (CONS 8 "2D-POLYLINE") (CONS 10 (LIST (CAR newpts)(CADR newpts)(CADDR newpts))) ) ;_ end of LIST ) ;_ end of ENTMAKE (IF (MEMBER (LIST (CAR newpts)(CADR newpts)(CADDR newpts)) usedpts_lst) NIL (PROGN (SETQ usedpts_lst (APPEND usedpts_lst (LIST (LIST (CAR newpts)(CADR newpts)(CADDR newpts))))) (SETQ newpts (MEMBER (CADDDR newpts) newpts)) ) ) ) (IF (ENTMAKE (LIST (CONS 0 "SEQEND");create the polyline sequence end and thus the new 2D polyline. (CONS 8 "2D-POLYLINE") ) ;_ end of LIST ) ;_ end of ENTMAKE (PROGN (COMMAND ".DRAWORDER" (ENTLAST) "" "U" (SSNAME tinobjs tincnt) "");display the new polyline under the surface (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (SETQ keep-3dpl (ukword 1 "Yes No" "Do you want to keep the boundary 3D polyline? [Yes/No]" (IF keep-3dpl keep-3dpl "No"))) (IF (EQ keep-3dpl "Yes") NIL (vlax-invoke-method 3dpolyobj 'Delete);delete the 3D polyline ) (IF plobjs NIL (SETQ plobjs (SSADD));create the polyline object selection set if it does not exist ) (SSADD (ENTLAST) plobjs);add the new 2D polyline to it (IF delplobjs NIL (SETQ delplobjs (SSADD));create the delete polyline object selection set if it does not exist ) (SSADD (ENTLAST) delplobjs);add the new 2D polyline to it also so we can easily delete it after the image is clipped. ) (ENTMAKE);clear out the ENTMAKE function in case there was an error during its earlier use. ) (SETQ tincnt (1+ tincnt));step the TIN counter and return to the top of the loop ) ) ) (IF plobjs (SETQ pliness NIL pliness plobjs ) ) (IF pliness (PROGN (COMMAND ".undo" "m") (SETQ plinesslen (SSLENGTH pliness) sscount 0 ) ;_ end of setq (WHILE (< sscount plinesslen) (SETQ currpline (SSNAME pliness sscount)) (SETQ plent (ENTGET currpline)) (SETQ img_layer (CDR (ASSOC 8 plent))) (IF plent NIL (SETQ bendpliness NIL abort_imgpl T ) ;_ end of SETQ ) ;_ end of IF (SETQ plvert (ENTGET (ENTNEXT (CDAR plent)))) (IF (OR (NOT (FINDFILE "1x1.bmp")) abort_imgpl) (COND ((NOT (FINDFILE "1x1.bmp")) (ALERT "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again." ) ;_ end of alert ) (abort_imgpl (SETQ abort_imgpl NIL)) ) ;_ end of COND (PROGN (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (SETQ autoimg (ukword 1 "Default Select" "elect image to clip or use efault image?" (IF autoimg autoimg "Default"))) (IF (WCMATCH autoimg "Default") (PROGN (COMMAND ".image" "a" "1x1" (CDR (ASSOC 10 plvert)) 1 0) (SETQ imgent (ENTGET (ENTLAST))) ) (PROGN (PRINC "\nSelect image to clip ") (PRINC) (SETQ imgent (ENTGET (CAR (ENTSEL)))) ) ) (PROGN (SETQ plvert_list (LIST (CONS 14 (CDR (ASSOC 10 plvert)))) ) ;_ end of SETQ ;;;----repeat this until the end of the polyline (WHILE (/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDAR plvert))))) "SEQEND" ) ;_ end of /= ;;;------if it begins an arc segment (IF (/= (CDR (ASSOC 42 plvert)) 0) ;;;--------do this (PROGN (SETQ found T) (SETQ plnvert (ENTGET (ENTNEXT (CDAR plvert)))) (SETQ strt40 (CDR (ASSOC 40 plvert))) (SETQ end41 (CDR (ASSOC 41 plvert))) (SETQ fpt1 (CDR (ASSOC 10 plvert))) (SETQ fpt2 (CDR (ASSOC 10 plnvert))) (SETQ chrdl (DISTANCE fpt1 fpt2)) (SETQ theta (ATAN (CDR (ASSOC 42 plvert)))) (SETQ psi (- (/ PI 2) (ABS theta))) (SETQ phi (* (ABS theta) 4)) (SETQ chang (ANGLE fpt1 fpt2)) (SETQ arcr (ABS (/ (* (DISTANCE fpt1 fpt2) (SIN psi)) (* 2 (COS theta) (SIN (* 2 theta))) ) ;_ end of / ) ;_ end of abs ) ;_ end of setq (SETQ arcc (IF (> theta 0) (POLAR fpt1 (+ (- chang theta) psi) arcr) (POLAR fpt1 (- (- chang theta) psi) arcr) ) ;_ end of if ) ;_ end of setq (SETQ ;fenl (* phi arcr) usrrad (* (/ 5.0 180.0000) PI) count (1+ (FIX (/ phi usrrad))) plwinc (/ (- strt40 end41) count) plwe (+ strt40 plwinc) incra (/ phi count) incrn 0 initang (ANGLE arcc fpt1) ) ;_ end of setq (WHILE (> count 0) (SETQ incrn (1+ incrn)) (SETQ plwb plwe plwe (- plwe plwinc) ) ;_ end of setq (IF (< theta 0) (SETQ fpt4 (POLAR arcc (- initang (* incrn incra)) arcr) ) ;_ end of setq (SETQ fpt4 (POLAR arcc (+ initang (* incrn incra)) arcr) ) ;_ end of setq ) ;_ end of if (SETQ plvert_list (APPEND plvert_list (LIST (CONS 14 fpt4)) ) ;_ end of APPEND ) ;_ end of SETQ (SETQ fpt1 fpt4 count (1- count) ) ;_ end of setq ) ;_ end of while (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert)))) ) ;_ end of progn ;;;--------or else it begins a line segment so do this (PROGN (SETQ fpt1 (CDR (ASSOC 10 plvert))) (SETQ fpt2 (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDAR plvert))))) ) ;_ end of setq (SETQ plvert_list (APPEND plvert_list (LIST (CONS 14 fpt2))) ) ;_ end of SETQ (SETQ fpt1 fpt2) (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert)))) ) ;_ end of progn ) ;_ end of if ) ;_ end of while ) ;_ end of progn (SETQ svplvert_list plvert_list) (SETQ sscount (1+ sscount)) (IF (AND plvert_list (/= (CAR plvert_list) (CAR (REVERSE plvert_list))) ) ;_ end of AND (SETQ plvert_list (APPEND plvert_list (LIST (CAR plvert_List)) ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of IF (imgplclp imgent plvert_list) (COMMAND "._draworder" (CDR (ASSOC -1 imgent)) "" "U" pliness "") ;;; (PRINC "\n") ;;; (PRINC (CAR plvert_list)) ;;; (PRINC "\n") ;;; (PRINC (CAR (REVERSE plvert_list))) ;;; (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (IF (AND delplobjs (>(SSLENGTH delplobjs)0)) (PROGN (SETQ delcnt 0) (WHILE (< delcnt (SSLENGTH delplobjs)) (ENTDEL (SSNAME delplobjs delcnt)) (SETQ delcnt (1+ delcnt)) ) ) ) ) ;_ end of progn ) ;_ end of if (SETQ pliness NIL bendpliness NIL ) ;_ end of SETQ (PRINC) ) ;_ end of defun (DEFUN C:IMGPL () (C:HIDEBDRY)) ;;;**************************************************************************** (DEFUN C:FADEIMAGE () (IF (>= (ATOI (SUBSTR (GETVAR "ACADVER") 1 2)) 17) (command "_.imageframe" "2") (command "_.imageframe" "on") ) (SETQ image_ss (SSGET '((0 . "IMAGE")))) (IF image_ss (PROGN (IF uint NIL (load "uint" "\nFile UINT.LSP not loaded! ")) (SETQ fade_percent (uint 1 "" "Percent fade for selected images?" fade_percent)) (SETQ imgss_length (SSLENGTH image_ss)) (SETQ imgcnt 0) (WHILE (< imgcnt imgss_length) (SETQ this_image (ENTGET (SSNAME image_ss imgcnt))) (SETQ this_image (SUBST (CONS 283 fade_percent)(ASSOC 283 this_image)this_image)) (ENTMOD this_image) (SETQ imgcnt (1+ imgcnt)) ) ) ) (IF (>= (ATOI (SUBSTR (GETVAR "ACADVER") 1 2)) 17) NIL (command "_.imageframe" "off") ) (PRINC) ) ;;;**************************************************************************** (DEFUN imgplclp (imgent imgclplst / imgminx imgmaxx imgminy imgmaxy imgbase imgedef img70 ) (FOREACH n imgclplst (IF imgminx (SETQ imgminx (MIN imgminx (CADR n))) (SETQ imgminx (CADR n)) ) ;_ end of if (IF imgminy (SETQ imgminy (MIN imgminy (CADDR n))) (SETQ imgminy (CADDR n)) ) ;_ end of if (IF imgmaxx (SETQ imgmaxx (MAX imgmaxx (CADR n))) (SETQ imgmaxx (CADR n)) ) ;_ end of if (IF imgmaxy (SETQ imgmaxy (MAX imgmaxy (CADDR n))) (SETQ imgmaxy (CADDR n)) ) ;_ end of if ) ;_ end of foreach (SETQ clpctr (POLAR (LIST imgminx imgminy 0) (ANGLE (LIST imgminx imgminy 0) (LIST imgmaxx imgmaxy 0)) (/ (DISTANCE (LIST imgminx imgminy 0) (LIST imgmaxx imgmaxy 0) ) ;_ end of distance 2.0 ) ;_ end of / ) ;_ end of polar axmax (MAX (- imgmaxx imgminx) (- imgmaxy imgminy)) ; maximum axial dimension of polyline area imgctr (POLAR (LIST imgminx imgminy 0) (/ PI 4.0) (* (/ 1.0 (SIN (/ PI 4.0))) (/ axmax 2.0)) ) ;_ end of polar ptfact 1.0 ;(/ 0.5 axmax); convert to unit values (axmax = 1.0 but center is at 0,0 and coords range from -0.5 to 0.5) ;;; imgins (LIST 0.0 0.0 0.0) imgins (LIST imgminx imgminy 0) ;;; imgins (LIST (* -0.5 axmax) (* -0.5 axmax) 0);(LIST (* -100.0 axmax) (* -100.0 axmax) 0); imgtr (LIST imgmaxx imgmaxy 0) ) ;_ end of SETQ ;;; (PRINC "\nimgins=") ;;; (PRINC imgins) ;;; (PRINC "\nptfact=") ;;; (PRINC ptfact) ;;; (PRINC) (IF from_clipimage NIL (FOREACH n imgclplst ;;; (PRINC "\nn=") ;;; (PRINC n) (SETQ relpt (POLAR (CDR n) (ANGLE imgctr '(0.0 0.0 0.0)) (DISTANCE imgctr '(0.0 0.0 0.0)) ) ;_ end of POLAR ) ;_ end of SETQ ;;; (PRINC "\nrelpt=") ;;; (PRINC relpt) (SETQ newpt (LIST (/ (CAR relpt) axmax) (* -1.0 (/ (CADR relpt) axmax)) 0.0 ) ;_ end of list ) ;_ end of SETQ ;;; (PRINC "\nnewpt 2 =") ;;; (PRINC newpt) ;;; (PRINC) (SETQ imgclplst (SUBST (CONS 14 newpt) n imgclplst)) ) ;_ end of FOREACH ) ;_ end of IF (SETQ assoc10 (CONS 10 imgins) assoc11 (CONS 11 (LIST axmax 0.0 0.0)) ;(CONS 11 (LIST (* 200 axmax) 0.0 0.0)); assoc12 (CONS 12 (LIST 0.0 axmax 0.0)) ;(CONS 12 (LIST 0.0 (* 200 axmax) 0.0)); ) ;_ end of SETQ (IF from_clipimage (PROGN (SETQ revimgent (REVERSE imgent)) (WHILE (EQ (CAAR revimgent) 14) (SETQ revimgent (CDR revimgent)) ) ;_ end of WHILE (SETQ imgent (REVERSE revimgent)) (FOREACH n imgclplst (SETQ imgent (APPEND imgent (LIST n))) ) ;_ end of FOREACH ;;; 91 = Set number of clip boundary vertices that follow (SETQ imgent (SUBST (CONS 91 (LENGTH imgclplst)) (ASSOC 91 imgent) imgent ) ;_ end of SUBST ) ;_ end of SETQ ;;; 71 = Set clipping boundary "polygonal" bit (SETQ imgent (SUBST (CONS 71 2) (ASSOC 71 imgent) imgent ) ;_ end of subst ) ;_ end of setq ;;; 280 = Set clipping state on (SETQ imgent (SUBST (CONS 280 1) (ASSOC 280 imgent) imgent ) ;_ end of subst ) ;_ end of setq ;;; 283 = Set fade percent (SETQ imgent (SUBST (CONS 283 85) (ASSOC 283 imgent) imgent ) ;_ end of subst ) ;_ end of setq (SETQ debug_imgent imgent) ) ;_ end of PROGN (SETQ imgent (SUBST assoc10 (ASSOC 10 imgent) imgent) imgent (SUBST assoc11 (ASSOC 11 imgent) imgent) imgent (SUBST assoc12 (ASSOC 12 imgent) imgent) ;;; 283 = Set fade percent imgent (SUBST (CONS 283 85) (ASSOC 283 imgent) imgent ) ;_ end of subst ) ;_ end of setq ) ;_ end of IF ;;; (PRINC "\nASSOC 10 = ") ;;; (PRINC assoc10) ;;; (PRINC "\nASSOC 11 = ") ;;; (PRINC assoc11) ;;; (PRINC "\nASSOC 12 = ") ;;; (PRINC assoc12) ;;; (PRINC) ;;; (IF ;;; (PRINC "\nimgent = ") ;;; (PRINC imgent) ;;; (PRINC) (ENTMOD imgent) ;;; NIL ;;; (PROGN ;;; (PRINC "\nENTMOD FAILED! (1) ") ;;; (PRINC "\nimgent=") ;;; (PRINC imgent) ;;; (PRINC) ;;; ) ;;; ) (IF from_clipimage (SETQ from_clipimage NIL) (PROGN (IF gvpno nil (LOAD "gvpno") ) ;_ end of if (gvpno) (IF set_mjrg NIL (LOAD "SET_MJRG" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) (SETQ imgbase (REVERSE (MEMBER (ASSOC 91 imgent) (REVERSE imgent))) ) ;_ end of SETQ (SETQ imgedef (APPEND imgbase imgclplst)) (SETQ img70 (ASSOC 70 imgedef)) (COND (img70 (IF (EQ (BOOLE 1 (CDR img70) 4) 4) ;"Use clipping boundary" bit is on nil (SETQ imgedef (SUBST (CONS 70 (+ (CDR img70) 4)) img70 imgedef) ) ;_ end of SETQ ) ;_ end of if ) (SETQ imgedef (APPEND imgedef (LIST (CONS 70 4)) imgedef)) ) ;_ end of COND (SETQ imgedef (SUBST (CONS 71 2) ;Set clipping boundary "polygonal" bit (ASSOC 71 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (SETQ imgedef (SUBST (CONS 91 (LENGTH imgclplst)) ;Number of clip boundary vertices that follow (ASSOC 91 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (SETQ imgedef (SUBST (CONS 280 1) ;Turn clipping state on (ASSOC 280 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq (COND ((AND plent (ASSOC 8 plent) (>= (STRLEN (CDR (ASSOC 8 plent))) 11) (NOT (WCMATCH (CDR (ASSOC 8 plent)) "*HIDE*")) ) ;_ end of AND (SETQ prev_clayr clayr clayr (CDR (ASSOC 8 plent)) ) (IF clnmstd NIL (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ")) (IF (AND clnmstd (clnmstd) (>= (STRLEN (CDR (ASSOC 8 plent))) 12) (WCMATCH (SUBSTR (CDR (ASSOC 8 plent)) 8) "*[AELPSV][LVHCI]##*") ) ;;; (NOT (WCMATCH ;;; (SUBSTR (CDR (ASSOC 8 plent)) 8 4) ;;; "[AELPSV][LVHCI]##" ;;; ) ;;; ) (PROGN (SETQ cnt 1) (SETQ layerkeystr (SUBSTR (CDR (ASSOC 8 plent)) 8)) (WHILE (AND (> (STRLEN (SUBSTR layerkeystr cnt)) 4) (< cnt (STRLEN layerkeystr)) (NOT (WCMATCH (SUBSTR layerkeystr cnt 4) "[AELPSV][LVHCI]##")) ) (SETQ cnt (1+ cnt)) ) (IF (WCMATCH (SUBSTR layerkeystr cnt 4) "[AELPSV][LVHCI]##") (SETQ layerkeystr (SUBSTR layerkeystr cnt 4)) (SETQ layerkeystr "") ) ) (SETQ layerkeystr "") ) (IF (WCMATCH layerkeystr (SUBSTR (CDR (ASSOC 8 plent)) 8 4)) (SETQ img_layer (STRCAT (SUBSTR (CDR (ASSOC 8 plent)) 1 1) "-" (SUBSTR (CDR (ASSOC 8 plent)) 3 4) "UHIDE-" (SUBSTR (CDR (ASSOC 8 plent)) 8 4) ) ;_ end of STRCAT ) ;_ end of SETQ (IF (EQ layerkeystr "") (SETQ img_layer (STRCAT (SUBSTR (CDR (ASSOC 8 plent)) 1 1) "-" (SUBSTR (CDR (ASSOC 8 plent)) 3 4) "U" (SUBSTR (CDR (ASSOC 8 plent)) 8 4) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ img_layer (STRCAT (SUBSTR (CDR (ASSOC 8 plent)) 1 1) "-" (SUBSTR (CDR (ASSOC 8 plent)) 3 4) "UHIDE-" layerkeystr ) ;_ end of STRCAT ) ;_ end of SETQ ) ) ) (T (if set_mjrg NIL (LOAD "set_mjrg" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) (IF (>= (STRLEN img_layer) 7) (SETQ img_layer (STRCAT (IF mjrg mjrg "G" ) ;_ end of IF (COND ((AND (WCMATCH (STRCASE (SUBSTR img_layer 3 4)) "HIDE,MASK")(<=(STRLEN img_layer)7)) (IF (OR (EQ(STRLEN img_layer) 6)(EQ(STRLEN img_layer) 7)) (STRCAT "-" (SUBSTR img_layer 3 4) "UHIDE") "-IMAGUHIDE" )) ((>=(STRLEN img_layer)11) (IF (WCMATCH (STRCASE img_layer) "*HIDE*,*MASK*") (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8)) (COND ((>= (STRLEN img_layer) 26) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 19) "-HIDE")) ((>= (STRLEN img_layer) 21) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 14) "-HIDE")) ((>= (STRLEN img_layer) 16) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 9) "-HIDE")) ((>= (STRLEN img_layer) 11) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 4) "-HIDE")) ) )) (T "-IMAGUHIDE") ) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ img_layer "G-OBJSUHIDE") ) ) ) ;_ end of COND (IF (WCMATCH (STRCASE img_layer) "*HIDE*,*MASK*") NIL (PROGN (if set_mjrg NIL (LOAD "set_mjrg" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) (SETQ img_layer (STRCAT (IF mjrg mjrg "G" ) ;_ end of IF (COND ((AND (WCMATCH (STRCASE (SUBSTR img_layer 3 4)) "HIDE,MASK")(<=(STRLEN img_layer)7)) (IF (OR (EQ(STRLEN img_layer) 6)(EQ(STRLEN img_layer) 7)) (STRCAT "-" (SUBSTR img_layer 3 4) "UHIDE") "-IMAGUHIDE" )) ((>=(STRLEN img_layer)11) (IF (WCMATCH (STRCASE img_layer) "*HIDE*,*MASK*") (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8)) (COND ((>= (STRLEN img_layer) 26) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 19) "-HIDE")) ((>= (STRLEN img_layer) 21) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 14) "-HIDE")) ((>= (STRLEN img_layer) 16) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 9) "-HIDE")) ((>= (STRLEN img_layer) 11) (STRCAT "-" (SUBSTR img_layer 3 4) "U" (SUBSTR img_layer 8 4) "-HIDE")) ) )) ) ) ;_ end of STRCAT ) ;_ end of SETQ ) ) (SETQ imgedef (SUBST (CONS 8 img_layer) ;Set layer name (ASSOC 8 imgedef) imgedef ) ;_ end of subst ) ;_ end of setq ;;; (IF (ENTMOD imgedef) ) ;_ end of PROGN ) ;_ end of IF ;;; NIL ;;; (PROGN ;;; (PRINC "\nENTMOD FAILED! (2) ") ;;; (PRINC "\nimgent=") ;;; (PRINC imgent) ;;; (PRINC) ;;; ) ;;; ) (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN C:CLIPIMAGE (/ pl_select img_select imgbnd_lst) (PRINC "\nSelect polyline for image boundary") (PRINC) (SETQ pl_select (ENTSEL)) (IF (>= (ATOI (SUBSTR (GETVAR "ACADVER") 1 2)) 17) (command "_.imageframe" "2") (command "_.imageframe" "on") ) (PRINC "\nSelect image") (PRINC) (SETQ img_select (ENTSEL)) (IF (AND pl_select (EQ (TYPE pl_select) 'LIST) (EQ (TYPE (CAR pl_select)) 'ENAME) (OR (EQ (CDR (ASSOC 0 (ENTGET (CAR pl_select)))) "POLYLINE") (EQ (CDR (ASSOC 0 (ENTGET (CAR pl_select)))) "LWPOLYLINE") ) ;_ end of OR img_select (EQ (TYPE img_select) 'LIST) (EQ (TYPE (CAR img_select)) 'ENAME) (EQ (CDR (ASSOC 0 (ENTGET (CAR img_select)))) "IMAGE") ;;; (OR ;;; (AND ;;; (>(SETQ img_angle (ATAN (/ (CADDR (ASSOC 11 (SETQ img_entdef (ENTGET (CAR img_select))))) ;;; (CADR (ASSOC 11 img_entdef)) ;;; ) ;_ end of / ;;; ) ;_ end of ATAN ;;; ) ;;; (* PI 1.5) ;;; ) ;;; (< img_angle (* PI 2.0)) ;;; ) ;;; (AND ;;; (<= img_angle (* PI 0.5)) ;;; (>= img_angle 0.0) ;;; ) ;;; debug_anyimgpl ;;; ) ) ;_ end of AND (PROGN (SETQ imgbnd_lst NIL) (SETQ pl_entdef (ENTGET (CAR pl_select))) (SETQ img_entdef (ENTGET (CAR img_select))) (IF (EQ (CDR (ASSOC 0 pl_entdef)) "POLYLINE") (PROGN (SETQ header_ename (CDR (ASSOC -1 pl_entdef))) (SETQ pl_ent (ENTGET (ENTNEXT header_ename))) (WHILE (/= (CDR (ASSOC 0 pl_ent)) "SEQEND") (SETQ imgbnd_lst (APPEND imgbnd_lst (LIST (LIST (CADR (ASSOC 10 pl_ent)) (CADDR (ASSOC 10 pl_ent)) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ pl_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 pl_ent))))) ) ;_ end of WHILE ) ;_ end of PROGN (IF (EQ (CDR (ASSOC 0 pl_entdef)) "LWPOLYLINE") (PROGN (WHILE (MEMBER (ASSOC 10 pl_entdef) pl_entdef) (SETQ imgbnd_lst (APPEND imgbnd_lst (LIST (LIST (CADR (ASSOC 10 pl_entdef)) (CADDR (ASSOC 10 pl_entdef)) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ pl_entdef (CDR (MEMBER (ASSOC 10 pl_entdef) pl_entdef)) ) ;_ end of SETQ ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ img_angle (ATAN (/ (CADDR (ASSOC 11 img_entdef)) (CADR (ASSOC 11 img_entdef)) ) ;_ end of / ) ;_ end of ATAN img_width (* (DISTANCE '(0.0 0.0 0.0) (CDR (ASSOC 11 img_entdef)) ) ;_ end of DISTANCE (CADR (ASSOC 13 img_entdef)) ) ;_ end of * img_height (* (DISTANCE '(0.0 0.0 0.0) (CDR (ASSOC 12 img_entdef)) ) ;_ end of DISTANCE (CADDR (ASSOC 13 img_entdef)) ) ;_ end of * img_scale (/ img_width (CADR (ASSOC 13 img_entdef))) img_orig_c (LIST 0.5 (- (CADDR (ASSOC 13 img_entdef)) 0.5) 0.0) img_orig_v (CDR (ASSOC 10 img_entdef)) transpts NIL ) ;_ end of SETQ (FOREACH n imgbnd_lst (SETQ pt_dis1 (DISTANCE img_orig_v n) pt_dist (/ pt_dis1 img_scale) pt_ang1 (ANGLE img_orig_v n) pt_ang2 (- pt_ang1 img_angle) pt_angle (- (* PI 2.0) pt_ang2) ) ;_ end of SETQ (IF (OR (AND (> (ABS img_angle) (* PI 1.5)) (< (ABS img_angle) (* PI 2.0)) ) ;_ end of AND (AND (<= (ABS img_angle) (* PI 0.5)) (>= (ABS img_angle) 0.0) ) ;_ end of AND ) ;_ end of OR NIL (SETQ pt_angle (+ pt_angle PI)) ) ;_ end of IF (SETQ new_n_pt (POLAR img_orig_c pt_angle pt_dist) transpts (APPEND transpts (LIST (CONS 14 new_n_pt))) ) ;_ end of SETQ ) ;_ end of FOREACH (IF (/= (CAR transpts) (LAST transpts)) (SETQ transpts (APPEND transpts (LIST (CAR transpts)))) ) ;_ end of IF ;;; (PRINC "\ntranspts = ") ;;; (PRINC transpts) ;;; (PRINC) (SETQ from_clipimage T) (imgplclp img_entdef transpts) (SETQ from_clipimage NIL) (IF ukword NIL (LOAD "UKWORD" "\nFile UKWORD.LSP not loaded! ")) (SETQ del_pl_select (ukword 1 "Yes No" "Delete polyline?" (IF del_pl_select del_pl_select "No"))) (IF (EQ del_pl_select "Yes") (ENTDEL (CAR pl_select)) ) ) ;_ end of PROGN (PROGN ;;; (IF ;;; (AND ;;; img_angle ;;; (NOT ;;; (OR ;;; (AND ;;; (> img_angle (* PI 1.5)) ;;; (< img_angle (* PI 2.0)) ;;; ) ;;; (AND ;;; (<= img_angle (* PI 0.5)) ;;; (>= img_angle 0.0) ;;; ) ;;; ) ;;; ) ;;; ) ;;; (ALERT "Image angle must be greater than 270° and less than 360°\nor greater than or equal to 0° and less than or equal to 90°.\n(visually, between +90° and -90°)") ;;; ) ) ) ;_ end of IF (IF (>= (ATOI (SUBSTR (GETVAR "ACADVER") 1 2)) 17) NIL (command "_.imageframe" "off") ) (PRINC) ) ;_ end of DEFUN (DEFUN C:CLIPOLY () (C:CLIPIMAGE)) ;;;**************************************************************************** (DEFUN C:DEBUGCLIPOLY () (COMMAND ".pline") (FOREACH n debug_imgent (IF (MEMBER n clip0) nil (PROGN (PRINC "\n") (PRINC n) (PRINC) (IF (EQ (CAR n) 14) (COMMAND (CDR n))rea ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of foreach ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;