0 Members and 1 Guest are viewing this topic.
...do anything else with a SPLINE ??
(defun C:SPLINE2PLINE (/ SPLINES PLINETYPE OSMODE I SPL ED CODEPAIR) (if (setq SPLINES (ssget (list (cons 0 "spline")))) (progn (if (zerop (setq PLINETYPE (getvar "plinetype"))) (setvar "plinetype" 1) ) ;if (setq OSMODE (getvar "osmode")) (setvar "osmode" 0) (setq I 0) (while (setq SPL (ssname SPLINES I)) (setq I (1+ I) ED (entget SPL) ) ;setq (command ".pline") (foreach CODEPAIR ED (if (= 10 (car CODEPAIR)) (command (cdr CODEPAIR)) ) ;if ) ;foreach (command "") (command ".pedit" "l" "s" "") ) ;while (if PLINETYPE (setvar "plinetype" PLINETYPE) ) (setvar "osmode" OSMODE) ) ;progn ) ;if (princ) ) ;defun
;;CADALYST 12/03 AutoLISP Solutions SPLINE-TO-PLINE.LSP;;(c) 2003 Tony Hotchkiss(defun spline-to-pline (/ i) (vl-load-com) (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object) ) ;_ end of vla-get-activedocument *modelspace* (vla-get-ModelSpace *thisdrawing*) ) ;_ end of setq (setq spline-list (get-spline)) (setq i (- 1)) (if spline-list (progn (setq msg "\nNumber of segments <100>: ") (initget 6) (setq num (getint msg)) (if (or (= num 100) (= num nil)) (setq num 100) ) ;_ end of if (repeat (length spline-list) (setq splobj (nth (setq i (1+ i)) spline-list)) (convert-spline splobj num) ) ;_ end of repeat ) ;_ end of progn ) ;_ end of if) ;_ end of spline-to-pline(defun get-spline (/ spl-list obj spline no-ent i) (setq spl-list nil obj nil spline "AcDbSpline" selsets (vla-get-selectionsets *thisdrawing*) ss1 (vlax-make-variant "ss1") ) ;_ end of setq (if (= (vla-get-count selsets) 0) (setq ssobj (vla-add selsets ss1)) ) ;_ end of if (vla-clear ssobj) (setq no-ent 1) (while no-ent (prompt "\nSelect splines: ") (vla-Selectonscreen ssobj) (if (> (vla-get-count ssobj) 0) (progn (setq no-ent nil) (setq i (- 1)) (repeat (vla-get-count ssobj) (setq obj (vla-item ssobj (vlax-make-variant (setq i (1+ i))) ) ;_ end of vla-item ) ;_ end of setq (cond ((= (vlax-get-property obj "ObjectName") spline) (setq spl-list (append spl-list (list obj)) ) ;_ end of setq ) ) ;_ end-of cond ) ;_ end of repeat ) ;_ end of progn (prompt "\nNo entities selected, try again.") ) ;_ end of if (if (and (= nil no-ent) (= nil spl-list)) (progn (setq no-ent 1) (prompt "\nNo splines selected.") (quit) ) ;_ end of progn ) ;_ end of if ) ;_ end of while (vla-delete (vla-item selsets 0)) spl-list) ;_ end of get-spline(defun convert-spline (splobj n / i) (setq point-list nil 2Dpoint-list nil z-list nil spl-lyr (vlax-get-property splobj 'Layer) startSpline (vlax-curve-getStartParam splobj) endSpline (vlax-curve-getEndParam splobj) i (- 1) ) ;_ end of setq (repeat (+ n 1) (setq i (1+ i)) (setq p (vlax-curve-getPointAtParam splobj (* i (/ (- endspline startspline) n) ) ;_ end of * ) ;_ end of vlax-curve-getPointAtParam ) ;_ end of setq (setq 2Dp (list (car p) (cadr p)) 2Dpoint-list (append 2Dpoint-list 2Dp) point-list (append point-list p) z (caddr p) z-list (append z-list (list z)) ) ;_ end of setq ) ;_ end of repeat (setq summ (apply '+ z-list)) (setq arraySpace (vlax-make-safearray vlax-vbdouble ; element type (cons 0 (- (length point-list) 1) ) ; array dimension ) ;_ end of vlax-make-safearray ) ;_ end of setq (setq vert-array (vlax-safearray-fill arraySpace point-list)) (vlax-make-variant vert-array) (if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar)) (= summ 0.0) ) ;_ end of and (setq plobj (add-polyline 2Dpoint-list vla-AddLightweightPolyline ) ;_ end of add-polyline ) ;_ end of setq (setq plobj (add-polyline point-list vla-Add3DPoly ) ;_ end of add-polyline ) ;_ end of setq ) ;_ end of if (vlax-put-property plobj 'Layer spl-lyr) (vla-delete splobj) (vlax-release-object splobj)) ;_ end of convert-spline(defun add-polyline (pt-list poly-func) (setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length pt-list) 1) ) ; array dimension ) ;_ end of vlax-make-safearray ) ;_ end of setq (setq vertex-array (vlax-safearray-fill arraySpace pt-list) ) ;_ end of setq (vlax-make-variant vertex-array) (setq plobj (poly-func *modelspace* vertex-array ) ;_ end of poly-func ) ;_ end of setq) ;_ end of add-polyline(defun c:s2p () (spline-to-pline) (princ)) ;_ end of c:s2p(prompt "SPLINE-TO-PLINE by Tony Hotchkiss. Enter S2P to start") ;_ end of prompt