Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 11/22/2022 in all areas

  1. This is a bit different than the lisp ronjonp linked. instead of degrees it uses a minimum length to generate points. It will always divide an arc into 5 equal segments or if the arc can be divided more then 5 by the minimum distance the higher division will be used. the larger outline went from 52 vertices to 656. see example. Apparently you can test for bluge with visual lisp (seen in lisp ronjonp linked). So it make the code a lot simpler. no longer have to explode the polyline. Again thank you @Sambo for pointing out the errors my earlier lisp was making. ;;----------------------------------------------------------------------------;; ;; ssget "WP" doesn't work well with polylines with arcs. This fixes it. (defun selectinside (ent / poly v i ii x bulge seg lst) (setq poly (vlax-ename->vla-object ent) v (vlax-curve-getEndParam poly) i 0 x 3 ;x = how often you want a point along arc ) (while (< i v) (if (/= 0 (abs (vlax-invoke poly 'GetBulge i))) ;pulled from lisp ronjonp linked (progn (setq ii 0) (if (>= (setq seg (fix (/ (- (vlax-curve-getDistAtParam poly (1+ i)) (vlax-curve-getDistAtParam poly i)) x))) 5) (repeat seg (setq lst (cons (vlax-Curve-GetPointAtParam poly (+ i ii)) lst)) (setq ii (+ (/ 1.0 seg) ii)) ) (repeat 5 (setq lst (cons (vlax-Curve-GetPointAtParam poly (+ i ii)) lst)) (setq ii (+ 0.20 ii)) ) ) ) (setq lst (cons (vlax-Curve-GetPointAtParam poly i) lst)) ) (setq i (1+ i)) ) (if (not (member (setq end (vlax-curve-getEndPoint poly)) lst)) (setq lst (cons end lst)) ) (setq SS1 (ssget "_WP" lst)) (setq SS2 (ssget "_CP" lst)) ) ;;----------------------------------------------------------------------------;; ;; entmake polyline for checking points created. ;; (make-poly pnt-lst t) ;closed polyline ;; (make-poly pnt-lst nil) ;open polyline (defun make-poly (pts closed) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)) ;number of vertices (cons 70 (if closed 1 0)) ) (mapcar '(lambda (x) (cons 10 x)) pts) ) ) ) selectinside.dxf
    1 point
  2. Cad64... it just goes to prove there are many ways to derive the 3D model. Nice job with a clear explanation. Kudos.
    1 point
  3. The above post has now been updated with the new code. I believe it fixes all the bugs.
    1 point
  4. @mhupp your codes fixed now. See Below Note: This updated code now works on an approx. Sagitta distance instead of a number of segments (makes it easier for me to approximate polys with a more consistent error from the poly for the arks). I've also set the minimum number of segments for any ark at 4 (this will override the approx. Sagitta distance when needed). (defun SELECTINSIDE (ent / obj poly polylen len counter Sagitta HalfCord ArcLen seg x) (Set_osmode nil) (setq lst nil) (setq poly (vlax-invoke (vlax-ename->vla-object ent) 'explode)) (setq polylen (length poly)) (setq counter 0) (setq Sagitta 0.5) ;;; max distance from the curve (while (< counter polylen) (cond ((eq (vla-get-Objectname (nth counter poly)) "AcDbArc") (setq HalfCord (sqrt (- (* 2 sagitta (vla-get-radius (nth counter poly))) (* sagitta sagitta)))) (setq ArcLen (/ (* (* pi (+ (* HalfCord HalfCord) (* sagitta sagitta))) (RtD (asin (/ (* 2 HalfCord sagitta) (+ (* HalfCord HalfCord) (* sagitta sagitta)))))) (* 180.0 Sagitta))) (Setq x (ceil (/ (vla-get-arclength (nth counter poly)) ArcLen))) (if (< x 4) (setq x 4)) (setq seg (/ (vla-get-arclength (nth counter poly)) x)) (if (/= counter 0) (progn (if (or (= (LM:roundm (distance (vlax-get (nth (- counter 1) poly) 'EndPoint) (vlax-get (nth counter poly) 'StartPoint)) 0.001) 0) (= (LM:roundm (distance (vlax-get (nth (- counter 1) poly) 'StartPoint) (vlax-get (nth counter poly) 'StartPoint)) 0.001) 0)) (progn (setq lst (cons (vlax-get (nth counter poly) 'StartPoint) lst)) (setq len 0) (repeat (1- x) (setq len (+ len seg)) (setq lst (cons (vlax-curve-getPointAtDist (nth counter poly) len) lst)) );end repeat );end progn (progn (setq lst (cons (vlax-get (nth counter poly) 'EndPoint) lst)) (setq len (vla-get-arclength (nth counter poly))) (repeat (1- x) (setq len (- len seg)) (setq lst (cons (vlax-curve-getPointAtDist (nth counter poly) len) lst)) );end repeat );end progn else );end if );end progn (progn (if (or (= (LM:roundm (distance (vlax-get (nth (+ counter 1) poly) 'EndPoint) (vlax-get (nth counter poly) 'EndPoint)) 0.001) 0) (= (LM:roundm (distance (vlax-get (nth (+ counter 1) poly) 'StartPoint) (vlax-get (nth counter poly) 'EndPoint)) 0.001) 0)) (progn (setq lst (cons (vlax-get (nth counter poly) 'StartPoint) lst)) (setq len 0) (repeat (1- x) (setq len (+ len seg)) (setq lst (cons (vlax-curve-getPointAtDist (nth counter poly) len) lst)) );end repeat );end progn (progn (setq lst (cons (vlax-get (nth counter poly) 'EndPoint) lst)) (setq len (vla-get-arclength (nth counter poly))) (repeat (1- x) (setq len (- len seg)) (setq lst (cons (vlax-curve-getPointAtDist (nth counter poly) len) lst)) );end repeat );end progn else );end if );end progn else );end if ) ((eq (vla-get-Objectname (nth counter poly)) "AcDbLine") (setq lst (cons (vlax-get (nth counter poly) 'StartPoint) lst)) ) ) (Setq counter (+ counter 1)) ) (foreach obj poly (vla-delete obj) ) (Set_osmode t) (setq SS1 (ssget "_WP" lst)) ;(setq SS2 (ssget "_CP" lst)) ;used for testing if anything is crossing ) ;;;;;;;;Required Subfunctions to run (SELECTINSIDE) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun asin (x) ;;;Arc Sin function (cond ((equal x 1.0 1.0e-16) (* pi 0.5) ) ((equal x -1.0 1.0e-16) (* pi -0.5) ) ((< (abs x) 1.0) (atan (/ x (sqrt (- 1.0 (* x x))))) ) (T (prompt "\n*ERROR* (abs x) > 1.0 from ASIN function\n") ) ) ) (defun RtD (r) (* 180.0 (/ r pi))) ;;;converts radians to degrees (defun ceil (x / n) ;;;;;Rounds 'x' up to the nearest intiger (if (or (= (setq n (fix x)) x) (< x 0)) n (1+ n) ) ) (defun LM:roundm ( n m ) ;;;;;Rounds 'n' to the nearest multiple of 'm' (* m (atoi (rtos (/ n (float m)) 2 0))) ) (defun Set_osmode (flg) ; nil=OFF t=ON (if (or (and flg (>= (getvar "osmode") 16383)) ; ON & osmode is off (and (null flg) (<= (getvar "osmode") 16383)) ; OFF & osmode is ON ) (setvar "osmode" (boole 6 (getvar "osmode") 16384)) ; Toggle osmode ) ) ;;;;;;;;Test Subfunctions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:test ( / e ) ;;;;;used to test what the selection set is actually selecting (if (and (setq e (car (entsel))) (member (cdr (assoc 0 (entget e))) '("CIRCLE" "ELLIPSE" "SPLINE" "LWPOLYLINE" "POLYLINE")) ) (sssetfirst nil (selectinside e)) ) (princ) ) (vl-load-com) (princ) (defun Drawlst () ;;;;;used to see what the list for the selection set looks like (Set_osmode nil) (command "pline") (foreach n lst (command n) );;end foreach (command "") (Set_osmode t) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1 point
  5. Ok, here's my toothbrush. It took about 30 minutes. It's all pretty straightforward modeling operations. The only tricky part was the transition piece connecting the head to the shaft. For the shaft, I drew the profile and Revolved it. For the head, I drew the outline and then extruded it up a little. Then I put a Fillet radius around the bottom edge. Then I Mirrored it and Unioned both pieces together. For the brush, I just created a bunch of cylinders and arranged them on the head. Then I Unioned them all together. Then I created the two large cylinders and subtracted them from the brush cylinders. The transition piece was tricky, like I said, but I was able to create it with a Loft. The only problem is the Loft creates a surface, not a solid, and Autocad refuses to convert the surface to a solid, so the head, the shaft and the transition piece are all separate parts. I don't know if any of that helps, but give it a try and see how far you can get. By the way, I have moved this thread to the Autocad 3D Modeling section: https://www.cadtutor.net/forum/forum/14-autocad-3d-modelling-amp-rendering/
    1 point
  6. Make sure QAFLAGS = 1 Then use (command "layer") to open the layer manager. (setvar "qaflags" 1) (command "layer")
    1 point
  7. Hello everyone. In response to a private message request, here is an update to the uvVectorMap routine. NOTE: I'm flying blind here. I don't have access to any version beyond AutoCAD 2018 so these DLLs (exactly the same as uvVectorMap 2016) my cause problems in latter versions. The only difference in this 2021 bundle was a modification in 'PackageContents.xml' to allow for use in 2016+. I expect everything will work fine, but the prospective beta testers will have to confirm that for me. STSC_uvVectMapBeta_1-2021.bundle.zip
    1 point
×
×
  • Create New...