;------------------------------------------------------------------------------
; Copyright (C) 2012 CAD Concepts Limited.
;
; MYSWEEP
;
; Apart from exceptions (listed below) This work by CAD Concepts Ltd is
; licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
; http://creativecommons.org/licenses/by-sa/3.0/nz/deed.en
; For options available to you under this license.
;
; EXCEPTIONS
; The following are not the work of CAD Concepts Limited. And are subject
; to the copyright conditions of the respective Authors.
;
; Function Author
; CCL:NORMALVECTORS Lee Mac, http://www.lee-mac.com
; Align3d.lsp Highflybird, http://www.theswamp.org/index.php?action=profile;u=2346
;
;
; This software is provided "as is". No liability is taken of
; FITNESS FOR ANY PARTICULAR PURPOSE.
;------------------------------------------------------------------------------
; File : MYSWEEP.lsp
; Author : Jason Bourhill
; Web : http://www.cadconcepts.co.nz
; Date : 21/October/2012
; CAD Ver(s) : Tested on BricsCAD V12 & V13, AutoCAD 2012
;
; PURPOSE:
; Extrudes selected profile(s) along a path(s). Done to mimic the SWEEP command
; which is currently not available in BricsCAD
;
;
; USAGE:
; To load type (load "MYSWEEP.LSP") from the command line or drag and drop the
; file onto your drawing using explorer. To run the routine type MYSWEEP at the
; command line. You will be prompted to select polyline profiles to extrude.
; You will then be asked to pick a base point (alignment to the path(s) will be
; relative to the selected point), you are then asked to select path(s) to
; extrude the profile along.
;
; REQUIRES:
; Load these routines if the are not loaded already
(if (not CCL:GSVAR
)(load "ccl-gsvar.lsp")) ; CCL:GSVARS ; defined in on_doc_load / acaddoc.lsp (if (not align3d
) (load "align3d.lsp")) ; ALIGN3D ; defined in align3d.lsp
;------------------------------------------------------------------------------
; Rev no : A
; Reason : First release
; Rev Date : 21/October/2012
; Rev by : Jason Bourhill
; Email : jason@cadconcepts.co.nz
;
; Description:
; First release.
;------------------------------------------------------------------------------
; CCL:DUPLICATE
; Create a duplicate copy of the given entity
; returns the entity name of the new object
(defun CCL:DUPLICATE
(ent
/ obj copyobj
) (vlax-vla-object->ename copyobj); return the entity name of the new object
); end DEFUN CCL:DUPLICATE
; CCL:SUMV
; returns the sum of two vectors
; e.g. use to combine a base point with a relative direction vector to find target point
)
; CCL:GETPOINTS
; use to get points relative to a basepoint
(defun CCL:GETPOINTS
(basepoint dirvecs
) (mapcar '
(lambda ( v
) (CCL:SUMV basepoint v
)) ; call to calc point for each direction vector dirvecs
)
)
; CCL:NORMALVECTORS
; returns a list of 3 Normal Vectors representing the
; X, Y, and Z direction relative to 2 given points using AutoDESKs Arbitrary Axis Algorithm
;
; Source Lee Mac
; http://www.theswamp.org/index.php?topic=43000.0
; see also
; Detail on AutoCAD Method http://docs.autodesk.com/ACD/2011/ENU/filesDXF/WS1a9193826455f5ff18cb41610ec0a2e719-793d.htm
; http://en.wikipedia.org/wiki/Cross_product
; http://www.wolframalpha.com/input/?i=Cross+product
; http://mathworld.wolfram.com/CrossProduct.html
(defun CCL:NORMALVECTORS
( p1 p2
/ z
) (setq z
(mapcar '
- p2 p1
)) ; find the relative direction vector from p2 to p1. This identifies the Z axis direction (mapcar '
(lambda ( v
) (trans v z
0 T
)) ; call trans to calc cross product for each direction '(
(1.0 0.0 0.0) ; X Normal
(0.0 1.0 0.0) ; Y Normal
(0.0 0.0 1.0) ; Z Normal
)
)
); end DEFUN CCL:NORMALVECTORS
; CCL:LISTCOORDS
; Returns a list of 3D coordinates for a given entity
; Polylines returns a list with a point for each coordinate
; Lightweight Polylines uses the elevation for Z coordinate
; Closed polylines will have the start point appended to the end of the list
; all other objects checks whether a start and end point is available and returns a list of these points if available
(defun CCL:LISTCOORDS
(ent
/ obj objtype objcoords coorList coordtype elevation numcoords num xval yval zval pointlst
) ; Using visual lisp. Make sure the visual lisp extensions are available
; CONDITION 1
; Object is a Lightweight, 2d, or 3d Polyline
; return a list of the coordinates
((or (= objtype
"AcDbPolyline") (= objtype
"AcDb2dPolyline") (= objtype
"AcDb3dPolyline")) ; (setq objcoords (vlax-get-property obj 'coordinates); Alternative method to retrieve these properties
(setq coordList
(vlax
-safearray
->list (vlax
-variant-value objcoords
))) ; convert coordinates from an array to a list (if (= objtype
"AcDbPolyline") ; If the object is a Lightweight Polyline coordtype 2 ; THEN set number of coordinates to 2
)
(setq coordtype
3) ; ELSE set number of coordinates to 3 ); end if
(setq numcoords
(/ (length CoordList
) coordtype
)) ; calculate the number off coordinates in the list ;(princ (strcat "\nNumber coords " (itoa numcoords) "\n"))
(setq num
0); zero counter (setq xval
(nth num coordlist
)) ; Get the X value (setq num
(1+ num
)); Iterate counter to the Y value (setq yval
(nth num coordlist
)) ; Get the Y value (if (= coordtype
2) ; if this is a 2D coordinate list (setq zval elevation
) ; then set the Z to the given elevation (setq num
(1+ num
) ; otherwise iterate the counter and get the Z from the coordinate list )
)
(setq pointlst
(cons (list xval yval zval
) pointlst
)) ; THEN add it to our points list (setq num
(1+ num
)); Iterate counter to the next X Value ); end Repeat
(setq pointlst
(append pointlst
(list (car pointlst
)))) ; Then add the start point to the end of the list ); end if
) ; end CONDITION 1
; CONDITION 2
; For all other objects
; return a list of the start & end point if available
(T
(vlax
-safearray
->list (vlax
-variant-value objPoint
)) ; convert the point from an array to a list )
)
) ;end mapcar
)
); end if
); end CONDITION 2
); end COND Statement
; return the points list
pointlst
); end CCL:LISTCOORDS
; CCL:SWEEPPROFILE
; Extrudes a profile along a path(s) relative to a basepoint
; will work with multiple profiles & paths
(defun CCL:SWEEPPROFILE
(profiles basepoint paths
/
objAcad objDoc
1stSourcePt prfnum prfent pathnum
ThisPrf ThisPrfProps ThisPrfNormal 2ndSourcePt SourceNormals SourcePts
pathent pathpoints 1stDestPt 2ndDestPt DestNormals DestPts
)
(setq 1stSourcePt
(trans basepoint
1 0)); translate the basepoint from the current UCS to World (setq prfnum
0) ; zero counter (repeat (sslength profiles
) ; repeat for each profile in the selection set (setq prfent
(ssname profiles prfnum
)) ; retrieve the entity name (setq pathnum
0) ; zero counter ; Set source details
(setq ThisPrf
(CCL:DUPLICATE prfent
)) ; create a copy of our object (setq ThisPrfProps
(entget ThisPrf
)) ; retrieve the properties of the copied object (setq ThisPrfNormal
(cdr (assoc 210 ThisPrfProps
))) ; retrieve the normal direction vector (setq 2ndSourcePt
(CCL:SUMV 1stSourcePt ThisPrfNormal
)) ; retrieve point normal to our 1stSourcePt (setq SourceNormals
(CCL:NORMALVECTORS 1stSourcePt 2ndSourcePt
)) ; Find source normal vectors (setq SourcePts
(CCL:GETPOINTS 1stSourcePt SourceNormals
)) ; find source points ; Set destination details
(setq pathent
(ssname paths pathnum
)) ; retrieve the entity name (setq pathpoints
(CCL:LISTCOORDS pathent
)) ; retrieve path points (setq 1stDestPt
(car pathpoints
)) ; get start point on path (setq 2ndDestPt
(cadr pathpoints
)) ; get second point on path (setq DestNormals
(CCL:NORMALVECTORS 1stDestPt 2ndDestPt
)) ; Find destination normal vectors (setq DestPts
(CCL:GETPOINTS 1stDestPt DestNormals
)) ; find destination points ; Call Align3d to align profile to the end of our path
; This works, but the profile rotation doesn't match requirements
;(ALIGN3D (ssadd ThisPrf) 1stSourcePt 1stDestPt 2ndSourcePt 2ndDestPt nil nil nil)
; Align profile to the end of our path based on Normal vectors
; Extrude profile along the path
(command "._EXTRUDE" ThisPrf
"" "_PATH" pathent
) (setq pathnum
(1+ pathnum
)) ; Iterate counter to next object in selection set );end path repeat
(setq prfnum
(1+ prfnum
)) ; Iterate counter to next object in selection set ) ;end profile repeat
(prin1) ;make a quiet exit ); end DEFUN CCL:SWEEPPROFILE
; Extrude a multiple beam profiles along a selected path to create 3d Solid Beams
(defun C:MYSWEEP
( / SSetProfiles basepoint SSetPaths
) (CCL:GSVAR '(cmdecho delobj)) ; Save environment variables
(setvar "CMDECHO" 0) ; turn off command echo (setvar "DELOBJ" 1) ; Delete profile entities on extrusion (princ "\nSelect Profile(s) to use") ; Provide prompt (setq SSetProfiles
(ssget)) ; Select profiles (if (= (type SSetProfiles
) 'PICKSET
) ; if user has made a valid selection (setq basepoint
(getpoint "\nSelect a base point on the profile:")) ; Request user to pick a reference point (if (= (type basepoint
) '
LIST) ; if user has made a valid selection (princ "\nSelect the path(s) to sweep:") (setq SSetPaths
(ssget '
((-4 .
"<or")(0 .
"LINE")(0 .
"ARC")(0 .
"POLYLINE")(0 .
"LWPOLYLINE")(-4 .
"or>")))) ; Allow selection of only Line & Polyline objects (if (= (type SSetPaths
) 'PICKSET
) ; if user has made a valid selection (CCL:SWEEPPROFILE SSetProfiles basepoint SSetPaths) ; extrude each profile along each of the paths using the given basepoint.
); end progn
(princ "\nNo profile paths selected") ); end if
); end progn
(princ "\nNo Base Point selected") ); end if
)
(princ "\nNo profile selected") ); end if
(CCL:GSVAR T) ; Reset environment variables
(prin1); make a quiet exit ); end DEFUN C:MYSWEEP
(princ "\nCommand is: MYSWEEP")