Hi CAB,
I am back again. I have tried to modify your code but without any success.
One thing I must tell you that I have learned a lot from your provided code, I may not achieve the goal I am trying to but still Learning something from Masters like you. Thanks Again.
Below is the code I've edited, my edited portion may look messy.
Rules to create the panels perfectly is as follows:
1, Panels length should not differ which I've tried to edit.
2, Panels should not leave the polyline in any case.
3, Midpoints of width portion should not necessarily lie on polyline as polyline may have bulges.
4, If polyline is too sharp Panels can have less portion of polyline but not leave the polyline (i.e Travel distance method may not useful for this)
(Defun C:Panel (/ Plen Pwid overlap gap step pkpt pkpa strt end NextPt Panels pk stparm dist ps ps1 ps2);curve
(defun MakePanel (p1 p2 len wid / tmpent widmid space)
;; by CAB 03/22/2009
;; Expects pts to be a list of 2D or 3D points
;; Returns new pline object
(defun makePline (spc pts / norm elv pline)
(setq norm (trans '(0 0 1) 1 0 T)
elv (caddr (trans (car pts) 1 norm))
)
(setq pline
(vlax-invoke Spc 'addLightWeightPolyline
(apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 1 norm))
(list (car pt) (cadr pt)))
pts)))
)
(vla-put-Elevation pline elv)
(vla-put-Normal pline (vlax-3d-point norm))
pline
)
(setq Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
)
)
(setq ang1 (+ (angle p1 p2) (/ pi 2))
ang2 (+ ang1 pi)
wid (/ wid 2.)
)
(setq pobj (makePline Space (list (polar p1 ang1 wid) (polar p1 ang2 wid)
(polar p2 ang2 wid) (polar p2 ang1 wid))))
(vla-put-Closed pobj :vlax-true)
pobj
)
;;-----------------=={ Group by Number }==--------------------;;
;; ;;
;; Groups a list into a list of lists, each of length 'n' ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; l - List to process ;;
;; n - Number of elements by which to group the list ;;
;;------------------------------------------------------------;;
;; Returns: List of lists, each of length 'n' ;;
;;------------------------------------------------------------;;
(defun LM:GroupByNum (l n / r)
(if l
(cons
(reverse (repeat n
(setq r (cons (car l) r)
l (cdr l)
)
r
)
)
(LM:GroupByNum l n)
)
)
)
;;-----------------=={ Get Intersections }==------------------;;
;; ;;
;; Returns a list of all points of intersection between ;;
;; two objects ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; obj1, obj2 - VLA-Objects ;;
;;------------------------------------------------------------;;
;; Returns: List of intersection points, or nil ;;
;;------------------------------------------------------------;;
(defun LM:GetIntersections (obj1 obj2)
(LM:GroupByNum
(vlax-invoke obj1 'IntersectWith obj2 acExtendnone)
3
)
)
; Closest Vertex
(defun gc:GetClosestVertexTo (pl pt / pa)
(setq pa (vlax-curve-getParamAtPoint
pl
(vlax-curve-getClosestPointTo pl pt)
)
)
(if (< (rem pa 1) 0.5)
(vlax-curve-getPointAtParam pl (fix pa))
(vlax-curve-getPointAtParam pl (1+ (fix pa)))
)
)
;Furthest Vertex
(defun gc:GetFurthestVertexTo (pl pt / pa)
(setq pa (vlax-curve-getParamAtPoint
pl
(vlax-curve-getClosestPointTo pl pt)
)
)
(if (> (rem pa 1) 0.5)
(vlax-curve-getPointAtParam pl (fix pa))
(vlax-curve-getPointAtParam pl (1+ (fix pa)))
)
)
(setq Plen 8700. ;(getdist "\nSpecify Panel Length:")
Pwid 1500 ;(getdist "\nSpecify Panel Width:")
Overlap 400. ;(getdist "\nSpecify Overlapping between Panels:");refer drawing
gap 400. ;(getdist "\nSpecify gap between Route and First Panel:");refer drawing
step 1
)
(while (not
(and (setq curve (car (setq pk (entsel "\nSelect Polyline Route:"))))
(member (cdr (assoc 0 (entget curve))) '("LWPOLYLINE""POLYLINE"))
)))
(setq Coorlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget curve))))
(setq pk (cadr pk) ; picked point
pkpt (vlax-curve-getclosestpointto curve pk) ; make sure point is on the curve
pkpa (vlax-curve-getparamatpoint curve pkpt)
strt (vlax-curve-getstartparam curve)
end (vlax-curve-getendparam curve)
)
;; Is start point at the beginning or end of pline?
(if (< (vlax-curve-getdistatparam curve pkpa)
(- (vlax-curve-getdistatparam curve end) (vlax-curve-getdistatparam curve pkpa)))
(setq stparm strt
StartFlg t ; flag the pline direction
dist 0.0)
(setq stparm end
step (- step)
dist (vlax-curve-getdistatparam curve (vlax-curve-getendparam curve)))
)
;; Add the rectangles
(while
(progn
(cond
((null NextPt) ; first point, first time through loop
(setq NextPt (vlax-curve-getpointatdist curve (abs (- dist (- Plen Gap Overlap))))
pa (vlax-curve-getparamatdist curve (abs (- dist (- Plen Gap Overlap)))))
;(setq Panels (list (MakePanel (polar (setq ps (vlax-curve-getpointatparam curve stparm)) (angle NextPt ps) Gap)
;(vlax-curve-getpointatdist curve (abs (- dist (- Plen Gap)))) Plen Pwid)))
;)by CAB 03/22/2009
(setq ps1 (polar (setq ps (vlax-curve-getpointatparam curve stparm)) (angle NextPt ps) Gap)
ps2 (vlax-curve-getpointatdist curve (abs (- dist (- Plen Gap)))))
(if (/= (Vla-getBulge (vlax-ename->vla-object curve) 0) 0)
(setq ps2 (vlax-curve-getpointatparam curve (/ (+ (vlax-curve-getparamatpoint curve (nth 0 Coorlist)) (vlax-curve-getparamatpoint curve (nth 1 Coorlist))) 2))))
(if (/= (distance ps1 ps2) Plen); check if distance of points equal to Panel length
(setq ps2 (polar ps1 (angle ps1 ps2) Plen)))
(setq Panels (list (MakePanel ps1 ps2 Plen Pwid)))
(setq Pnllst (LM:GetIntersections (vlax-ename->vla-object curve) (vlax-ename->vla-object (entlast))))
(if (not (nth 1 Pnllst))
(progn
(setq NextPt (vlax-curve-getpointatdist curve (- (vlax-curve-getdistatpoint curve (nth 0 Pnllst)) Overlap))
pa (vlax-curve-getparamatdist curve (- (vlax-curve-getdistatpoint curve (nth 0 Pnllst)) Overlap))))
(progn
(setq NextPt (vlax-curve-getpointatdist curve (- (vlax-curve-getdistatpoint curve (nth 1 Pnllst)) Overlap))
pa (vlax-curve-getparamatdist curve (- (vlax-curve-getdistatpoint curve (nth 1 Pnllst)) Overlap)))))
)
((and (setq dist (vlax-curve-getdistatparam curve pa))
(setq pa (vlax-curve-getparamatdist curve (+ (* step plen) dist))))
(setq Pt (vlax-curve-getpointatparam curve pa))
(setq Clvchk (gc:GetClosestVertexTo curve (vlax-curve-getclosestpointto curve NextPt)))
(setq Frvchk (gc:GetFurthestVertexTo curve (vlax-curve-getclosestpointto curve NextPt)))
(if (minusp (- (vlax-curve-getdistatpoint curve Clvchk) (vlax-curve-getdistatpoint curve Frvchk)))
(setq forPt (list (car Frvchk) (cadr Frvchk)))
(setq forPt (list (car Clvchk) (cadr Clvchk))))
(if (/= (Vla-getBulge (vlax-ename->vla-object curve) (- (length Coorlist) (length (member forPt Coorlist)))) 0)
(setq Pt (vlax-curve-getpointatparam curve (/ (+ (vlax-curve-getparamatpoint curve NextPt) (vlax-curve-getparamatpoint curve forPt)) 2))))
(if (/= (distance NextPt Pt) Plen); check if distance of points equal to Panel length
(setq Pt (polar NextPt (angle NextPt Pt) Plen)))
(setq Panels (cons (MakePanel NextPt Pt Plen Pwid) Panels))
(setq pa (vlax-curve-getparamatdist curve (+ dist (* step (- plen Overlap)))))
(setq NextPt (vlax-curve-getpointatparam curve pa))
(if (null (setq dist (vlax-curve-getdistatpoint curve NextPt)))
(princ)
)
t
)
)
)
)
(princ))
@DEVITG
Using Measure command works more or less OK but sometimes not, Please see attached drawing.
I am already thankful to all but if any guide me I am more thankful to him.
Thanks and Best Regards
