0 Members and 2 Guests are viewing this topic.
(setq mySplineObj (vla-addSpline *ModelSpace* FitPointsData StartTan EndTan) )
Try this:Code - Auto/Visual Lisp: [Select](vlax-put mySplineObj 'Closed2 -1)
Command: DUMP-OBJECTSelect object: ; IAcadSpline: AutoCAD Spline Interface; Property values:; Application (RO) = Exception occurred; Area (RO) = 2.15625e+007; Closed (RO) = 0; Closed2 = 0 <---------------; ControlPoints = (13992.0 1892.69 0.0 14331.0 2848.65 0.0 ... ); Degree (RO) = 3; Degree2 = 3; Document (RO) = #<VLA-OBJECT IAcadDocument 0000004073afe598>; EndTangent = (0.0 0.0 0.0); EntityTransparency = "ByLayer"; FitPoints = (13992.0 1892.69 0.0 15547.5 4580.44 0.0 ... ); FitTolerance = 1.0e-006; Handle (RO) = "4E236"; HasExtensionDictionary (RO) = 0; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 00000040695a2678>; IsPeriodic (RO) = 0; IsPlanar (RO) = -1; IsRational (RO) = 0; KnotParameterization = 0; Knots = (0.0 0.0 0.0 0.0 3105.46 7862.9 ... ); Layer = "0"; Linetype = "BYLAYER"; LinetypeScale = 1.0; Lineweight = -1; Material = "ByLayer"; NumberOfControlPoints (RO) = 7; NumberOfFitPoints (RO) = 5; ObjectID (RO) = 295; ObjectName (RO) = "AcDbSpline"; OwnerID (RO) = 294; PlotStyleName = "ByLayer"; SplineFrame = 1; SplineMethod = 0; StartTangent = (0.0 0.0 0.0); TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000040695a2310>; Visible = -1; Weights = AutoCAD.Application: No weights available for polynomial spline; Methods supported:; AddFitPoint (2); ArrayPolar (3); ArrayRectangular (6); Copy (); Delete (); DeleteFitPoint (1); ElevateOrder (1); GetBoundingBox (2); GetControlPoint (1); GetExtensionDictionary (); GetFitPoint (1); GetWeight (1); GetXData (3); Highlight (1); IntersectWith (2); Mirror (2); Mirror3D (3); Move (2); Offset (1); PurgeFitData (); Reverse (); Rotate (2); Rotate3D (3); ScaleEntity (2); SetControlPoint (2); SetFitPoint (2); SetWeight (2); SetXData (2); TransformBy (1); Update ()
Quote from: ronjonp on July 09, 2015, 04:40:03 PMTry this:Code - Auto/Visual Lisp: [Select](vlax-put mySplineObj 'Closed2 -1)Bingo Thanks!!
It seems odd that a closed spline has a property of -1, one would think its a 1?
(KGA_Math_Dec_To_Bin32 -1) => "11111111111111111111111111111111"
;; Tree Canopy Splines (plines);; compiled by Cary Hulse 7/10/15;;;; create closed spline from 4 points to represent tree canopy;; input from CSV - format Tree#,canopy radii(n,e,s,w),E(X),N(Y);; assumes elevation of 0 for all points;; converts splines to plines;; creates objects on "LJ-PLNT-TREE-CNPY" layer;;;;original main code from http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/defining-points-for-spline-command/td-p/3399551;;with help from the swamp here: http://www.theswamp.org/index.php?topic=49729.0;; and here: http://www.theswamp.org/index.php?topic=1804.0;; Thanks to LeeMac, CAB and ronjonp;;;;(defun c:TREECAN (/ acadapp DOC *lst* *error* *ModelSpace* ptStartTan ptEndTan ptFit1 ptFit2 ptFit3 ptFit4 FitPoints ptlstlen FitPointsDataA FitPointsData StartTanA StartTan EndTanA EndTan mySplineObj StrBrk BNME DDEL FILE LNAME NL OFILE PT SPC TAG UFLAG VALLST X CRZ CRD CANOPY LAY CRZ2 STAT VIZ xc yc nr er sr wr) (vl-load-com) (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object))) (setq *ModelSpace* (vla-get-ModelSpace DOC)) ;; --{ Error Handler Function by Lee Mac }-- (defun *error* (msg) (and ofile (close ofile)) (and uflag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) ;; --{ StrBrk Function }-- By Lee Mac (defun StrBrk (str chrc / pos lst) (while (setq pos (vl-string-position chrc str)) (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos 2)))) (reverse (cons str lst))) ;; ;;----set layer and input data---- ;; (setq lname "LJ-PLNT-TREE-CNPY") ;; Layer Name ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;***********spline to pline converter subfunctions ************** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;from here: http://www.theswamp.org/index.php?topic=1804.0 ;; by CAB (defun spl2pl(spline / usrlay usrosm usrplw ent pdist idx ss pl plist pentlst) (setq pdist 1) ; distance between points on new pline (setq pentlst '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 7) (70 . 1);closed = 1 (43 . 0.0) (38 . 0.0) (39 . 0.0) ) ) (setq end '(210 0.0 0.0 1.0));define polyline group codes (progn (setq ent spline pl pentlst) (if (setq plist (Spline->Pline ent pdist)) (progn (foreach x plist (setq pl (append pl (list (cons 10 (list (car x)(cadr x))) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0)))) ) ;;set number of points in polyline (setq pl (append (subst (cons 90 (length plist)) (assoc 90 pl) pl) pl (list end)) ) ;; update layer (setq pl (subst (assoc 8 (entget ent)) (assoc 8 pl) pl)) (entmake pl);make polyline ;(entdel ent) ) ; progn ); endif ) ; progn (princ));defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;***********spline -> pline subfunction************** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;http://www.theswamp.org/index.php?topic=1804.0(defun Spline->Pline (oSpline tol / 1stPoint dist fullLength lastPoint plinePoints point) (setq 1stPoint (vlax-curve-getPointAtParam oSpline (vlax-curve-getStartParam oSpline)) lastPoint (vlax-curve-getPointAtParam oSpline (vlax-curve-getEndParam oSpline)) fullLength (vlax-curve-getdistatparam oSpline (vlax-curve-getendparam oSpline)) dist 0 plinePoints (list 1stPoint) ) (while (< (setq dist (+ dist tol)) fullLength) (if (setq point (vlax-curve-getPointAtDist oSpline dist)) (setq plinePoints (append plinePoints (list point))) ) ) (setq plinePoints (append plinePoints (list lastpoint)));;; Use the variable plinePoints (which is a list of vertex points));_end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;***********MAIN FINCTIONS************** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;COUNTER FUNCTION and input data (if (and *lst* (not (initget "Start Continue"))) (setq *lst* (if (= "Start" (getkword "\n[S]tart of File or [C]ontinue? <Continue> : ")) nil *lst*))) (if (or *lst* (setq file (getfiled "Select Input File" (cond (*load_file*) ("")) "csv;txt" 16))) (progn (setq uflag (not (vla-StartUndoMark doc)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (if (not *lst*) (progn (setq dDel (if (eq ".CSV" (strcase (vl-filename-extension file))) 44 32) *load_file* file ofile (open file "r")) (while (setq nl (read-line ofile)) (setq *lst* (cons (StrBrk nl dDel) *lst*))) (setq ofile (close ofile) *lst* (reverse *lst*)))) ;;begin spline creation for each entry in point list (while (setq x (car *lst*)) (setq xc (atof (nth 5 x)) yc (ATOF (nth 6 x)) );;_end setq ;(setq PT (LIST xc yc 0)) ;;set radius variables (setq nr (atof (nth 1 x)) ;north er (atof (nth 2 x)) ;east sr (atof (nth 3 x)) ;south wr (atof (nth 4 x)) ;west ) ;;set fit point values ======= (setq ptFit1 (list xc (+ yc nr) 0.0) ;north ptFit2 (list (+ xc er) yc 0.0) ;east ptFit3 (list xc (- yc sr) 0.0) ;south ptFit4 (list (- xc wr) yc 0.0) ;west ) ;;set start & end tangent values (setq ptStartTan (list 0.0 0.0 0.0) ptEndTan (list 0.0 0.0 0.0)) ;;create list of the fit point values (setq FitPoints (apply 'append (list ptFit1 ptFit2 ptFit3 ptFit4))) ;;create a safearray to hold the fit points (setq ptlstlen (length FitPoints)) (setq FitPointsDataA (vlax-make-safearray vlax-vbDouble (cons 0 (1- ptlstlen)))) ;;populate the safearray (vlax-safearray-fill FitPointsDataA FitPoints) ;;assign the safearray to a variant (setq FitPointsData (vlax-make-variant FitPointsDataA (logior vlax-vbarray vlax-vbDouble))) ;;create a safearray to hold the start tangent points (setq StartTanA (vlax-make-safearray vlax-vbDouble (cons 0 2))) ;;populate the safearray (vlax-safearray-fill StartTanA ptStartTan) ;;assign the safearray to a variant (setq StartTan (vlax-make-variant StartTanA (logior vlax-vbarray vlax-vbDouble))) ;;create a safearray to hold the end tangent points (setq EndTanA (vlax-make-safearray vlax-vbDouble(cons 0 2))) ;;populate the safearray (vlax-safearray-fill EndTanA ptEndTan) ;;assign the safearray to a variant (setq EndTan (vlax-make-variant EndTanA (logior vlax-vbarray vlax-vbDouble ))) ;;create the spline object (setq mySplineObj (vla-addSpline *ModelSpace* FitPointsData StartTan EndTan)) ;;close spline (vlax-put mySplineObj 'Closed2 -1) ;;change the color of the spline ;;(vla-Put-Color mySplineObj acBlue) ;;; CHECK FOR LAYER AND ADD IF NOT EXIST (or (tblsearch "LAYER" Lname) (vla-add (vla-get-layers doc) Lname)) ;put obj on correct layer (vla-put-layer mySplineObj LName) (vla-Update mySplineObj) ;; convert to pline (spl2pl (vlax-vla-object->ename mySplineObj)) (entdel (vlax-vla-object->ename mySplineObj)) (setq *lst* (cdr *lst*)) );_end while (setq uFlag (vla-EndUndoMark doc)) );_end progn );_end if (princ) );_end defun;;------------------------------------------------------------;;(princ)(princ (strcat "\n:: TreeCanopySplines.lsp | C. Hulse::" "\n:: Type \"TREECAN\" to Invoke ::" ))(princ);;------------------------------------------------------------;;
So what does this do? Trace a group of blocks?
Cool .. you have a drawing\CSV to share? I'd like to see the input and result drawing.