Author Topic: segment offset ?  (Read 7182 times)

0 Members and 1 Guest are viewing this topic.

dussla

  • Bull Frog
  • Posts: 254
segment offset ?
« on: March 15, 2008, 10:03:53 AM »
i thought  segment offset .
it is difficult to explain  with my poor english .
so i made a sample file.
you can see my  idea .

can you understand ?
is that routine possible ?
« Last Edit: March 15, 2008, 09:31:40 PM by dussla »

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #1 on: March 15, 2008, 01:27:57 PM »
Hi,

Here's my way

EDIT: corrected a missing parent.

Code: [Select]
;;; Polyarc-data
;;; Returns a list of the center, radius and angle of a 'polyarc'.

(defun polyarc-data (bu p1 p2 / ang rad cen area cg)
  (setq ang (* 2 (atan bu))
rad (/ (distance p1 p2)
       (* 2 (sin ang))
    )
cen (polar p1
   (+ (angle p1 p2) (- (/ pi 2) ang))
   rad
    )
  )
  (list cen (abs rad) ang)
)

;;; Clockwise-p
;;; Returns T if p1 p2 and p3 are clockwise

(defun clockwise-p (p1 p2 p3)
  (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)

;;; SEG-OFF
;;; Offsets a segment of polyline

(defun c:seg-off (/   space   ofdist  ent   pline   normal  side
  pick-pt param   p1   p2   bulge   start   end
  b-data  new swid ewid
)
  (vl-load-com)
  (or *acdoc*
    (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
      )
  )
  (or *ofdist* (setq *ofdist* 10.0))
  (if (setq
ofdist (getdist
(strcat "\nSpecify offset distance <" (rtos *ofdist*) ">: ")
       )
      )
    (setq *ofdist* ofdist)
    (setq ofdist *ofdist*)
  )
  (while
    (and
      (setq ent (entsel "\nSelect a polyline segment: "))
      (setq pline (vlax-ename->vla-object (car ent)))
      (= (vla-get-ObjectName pline) "AcDbPolyline")
      (setq normal (vlax-get pline 'Normal))
      (setq side (trans (getpoint "\nSpecify a point on offset side: ")
1
normal
)
      )
    )
     (setq pick-pt (trans (osnap (cadr ent) "_nea") 1 0)
   param   (fix (vlax-curve-getParamAtPoint pline pick-pt))
   p1    (trans (vlax-curve-getPointAtParam pline param) 0 normal)
   p2    (trans (vlax-curve-getPointAtParam pline (1+ param))
  0
  normal
   )
   start nil
     )
     (if (zerop (setq bulge (vla-getBulge pline param)))
       (if (clockwise-p p1 p2 side)
(setq start (polar p1 (- (angle p1 p2) (/ pi 2)) ofdist)
       end   (polar p2 (- (angle p1 p2) (/ pi 2)) ofdist)
)
(setq start (polar p1 (+ (angle p1 p2) (/ pi 2)) ofdist)
       end   (polar p2 (+ (angle p1 p2) (/ pi 2)) ofdist)
)
       )
       (progn
(setq b-data (polyarc-data bulge p1 p2))
(if (< (cadr b-data) (distance (car b-data) side))
   (setq start (polar p1 (angle (car b-data) p1) ofdist)
end   (polar p2 (angle (car b-data) p2) ofdist)
   )
   (if (< ofdist (cadr b-data))
     (setq start (polar p1 (angle p1 (car b-data)) ofdist)
   end (polar p2 (angle p2 (car b-data)) ofdist)
     )
   )
)
       )
     )
     (if start
       (progn
(setq new
(vlax-invoke
  space
  'addLightWeightPolyline
  (list (car start) (cadr start) (car end) (cadr end))
)
)
(vla-getWidth pline param 'swid 'ewid)
(vla-setBulge new 0 bulge)
(vla-setWidth new 0 swid ewid)
(foreach prop '(Elevation Layer Linetype
LinetypeGeneration LinetypeScale
Lineweight Normal TrueColor
)
   (if (vlax-property-available-p pline prop)
     (vlax-put new prop (vlax-get pline prop))
   )
)
       )
       (princ "\nOffset distance is greater than arc radius.")
     )
  )
  (princ)
)
« Last Edit: March 16, 2008, 03:10:50 AM by gile »
Speaking English as a French Frog

dussla

  • Bull Frog
  • Posts: 254
Re: segment offset ?
« Reply #2 on: March 15, 2008, 09:23:57 PM »
gile~ thank you good answer
but there is error

;error: bad argument type: VLA-OBJECT #<SUBR @0423771c vlax-get-acad-object>

i used  cad 2004 ~

 :-) :-) :-) :-) :-) :-)
« Last Edit: March 15, 2008, 11:28:07 PM by dussla »

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #3 on: March 16, 2008, 03:10:22 AM »
Oopss !
I forgot a parent.
It may work now.
Speaking English as a French Frog

dussla

  • Bull Frog
  • Posts: 254
Re: segment offset ?
« Reply #4 on: March 16, 2008, 04:38:10 AM »
thank you gile
but , pls ,could  you urgrade rountine ?
that roudine work only 1 segment
i want multi segment select offset ?

pls , see attached file ~
« Last Edit: March 16, 2008, 04:50:45 AM by dussla »

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #5 on: March 24, 2008, 07:28:39 AM »
Hi,

I tried something for a multi segments offset.

EDIT: works now whatever the current UCS and the pline OCS and elevation

EDIT 2: corrected the bug shown by Evgeniy

EDIT 3: 'Highlighting' selected segments

EDIT 4: added the ability of removing a selected segment from selection by clicking it.

Code: [Select]
;; OFSEGS -Gilles Chanteau- 2008/03/26
;; Offsets the selected segments of lwpolyline
;; Joined segments are offseted in a single lwpolyline
;; Keeps arcs and widthes
;; Works whatever the current UCS and the pline OCS and elevation

(defun c:ofsegs (/ ofdist   ent      pline    normal   elevat params
   points   side     closest  par      bulge p1
   p2     arc_data
  )
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (initget 6 "Through")
  (if (setq
ofdist (getdist
(strcat "\nSpecify offset distance or [Through] <"
(if (< (getvar "OFFSETDIST") 0)
   "Through"
   (rtos (getvar "OFFSETDIST"))
)
">: "
)
       )
      )
    (if (= ofdist "Through")
      (setvar "OFFSETDIST" -1)
      (setvar "OFFSETDIST" ofdist)
    )
    (setq ofdist (getvar "OFFSETDIST"))
  )
  (if (and (setq ent (entsel "\nSelect a segment to offset: "))
   (setq pline (vlax-ename->vla-object (car ent)))
   (= (vla-get-ObjectName pline) "AcDbPolyline")
   (setq normal (vlax-get pline 'Normal))
   (setq elevat (vla-get-Elevation pline))
      )
    (progn
      (setq params (cons (fix (vlax-curve-getParamAtPoint
pline
(trans (osnap (cadr ent) "_nea") 1 0)
      )
)
params
   )
      )
      (HighlightSegment pline (car params))
      (while
(setq ent (entsel "\nSelect next segment or <exit>: "))
(if (equal (vlax-ename->vla-object (car ent)) pline)
   (progn
     (setq par (fix (vlax-curve-getParamAtPoint
      pline
      (trans (osnap (cadr ent) "_nea") 1 0)
    )
       )
   params (if (member par params)
    (vl-remove par params)
    (cons par params)
    )
     )
     (redraw)
     (foreach p params (HighlightSegment pline p))
   )
)
      )
      (if (setq side (getpoint
       (if (minusp (getvar "OFFSETDIST"))
"\nSpecify through point: "
"\nSpecify point on side to offset: "
       )
     )
  )
(progn
  (redraw)
  (vla-StartUndoMark *acdoc*)
  (setq side (ilp
  (trans side 1 0)
  ((lambda (p)
     (trans (list (car p) (cadr p) (1+ (caddr p))) 2 0)
   )
    (trans side 1 2)
  )
  (trans (list 0 0 elevat) normal 0)
  normal
)
closest (vlax-curve-getClosestPointTo pline side T)
par (vlax-curve-getParamAtPoint pline closest)
  )
  (if (minusp (getvar "OFFSETDIST"))
    (setq ofdist (distance side closest))
  )
  (cond
    ((equal closest (vlax-curve-getStartPoint pline) 1e-9)
     (setq side (trans side 0 normal))
    )
    ((equal closest (vlax-curve-getEndPoint pline) 1e-9)
     (setq par (- par 1)
   side (trans side 0 normal)
     )
    )
    ((= (fix par) par)
     (setq side
    (polar
      (trans closest 0 normal)
      ((if
(clockwise-p
   (trans
     (vlax-curve-getPointAtParam pline (- par 0.1))
     0
     normal
   )
   (trans closest 0 normal)
   (trans
     (vlax-curve-getPointAtParam pline (+ par 0.1))
     0
     normal
   )
)
  +
  -
       )
(angle '(0 0 0)
       (trans (vlax-curve-getFirstDeriv pline par)
      0
      normal
      T
       )
)
(/ pi 2)
      )
      ofdist
    )
     )
    )
    (T
     (setq par (fix par)
   side (trans side 0 normal)
     )
    )
  )
  (setq bulge (vla-getBulge pline (fix par))
p1    (trans (vlax-curve-getPointAtParam pline (fix par))
     0
     normal
      )
p2    (trans (vlax-curve-getPointAtParam pline (1+ (fix par)))
     0
     normal
      )
  )
  (if (zerop bulge)
    (if (clockwise-p side p2 p1)
      (setq ofdist (- ofdist))
    )
    (progn
      (setq arc_data (PolyArc-data bulge p1 p2))
      (if (minusp bulge)
(if (< (cadr arc_data)
       (distance (car arc_data) side)
    )
  (setq ofdist (- ofdist))
)
(if (< (distance (car arc_data) side)
       (cadr arc_data)
    )
  (setq ofdist (- ofdist))
)
      )
    )
  )
  (mapcar
    (function
      (lambda (p)
(vl-catch-all-apply 'vla-Offset (list p ofdist))
(vla-delete p)
      )
    )
    (Copysegments pline params)
  )
  (vla-EndUndoMark *acdoc*)
)
      )
    )
    (princ "\nUnvalid entity.")
  )
  (princ)
)

;; CopySegments
;; Duplicates polyline segments at the same location
;; Consecutive selected segments are joined
;;
;; Arguments
;; pline : the source polyline (vla-object)
;; params ; the index list of segment to be copied
;;
;; Return
;; the list of created polylines

(defun CopySegments (pline params / nor space tmp copy ret)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq params (vl-sort params '<)
nor    (vlax-get pline 'Normal)
space  (vla-ObjectIDToObject *acdoc* (vla-get-OwnerID pline))
  )
  (while params 
    (setq tmp (cons (car params) tmp)
  params (cdr params)
    )
    (if (and (zerop (car tmp))
     (= (- (vlax-curve-getEndParam pline) 1) (last params))
     (equal (vlax-curve-getStartPoint pline)
    (vlax-curve-getEndPoint pline)
    1e-9
     )
)
      (progn
(setq params (reverse params)
      tmp    (cons (car params) tmp)
      params (cdr params)
)
(while (= (car params) (1- (car tmp)))
  (setq tmp    (cons (car params) tmp)
params (cdr params)
  )
)
(setq tmp    (reverse tmp)
      params (reverse params)
)
      )
    )
    (while (= (car params) (1+ (car tmp)))
      (setq tmp    (cons (car params) tmp)
    params (cdr params)
      )
    )
    (setq tmp (reverse (cons (1+ (car tmp)) tmp)))
    (setq
      pts
       (vl-remove nil
  (mapcar
    (function
      (lambda (pa / pt)
(if (setq pt (vlax-curve-getPointAtParam pline pa))
  ((lambda (p)
     (list (car p) (cadr p))
   )
    (trans pt 0 nor)
  )
)
      )
    )
    tmp
  )
       )
    )
    (setq copy
   (vlax-invoke
     space
     'addLightWeightPolyline
     (apply 'append pts)
   )
    )
    (foreach p (cdr (reverse tmp))
      (vla-setBulge
copy
(vl-position p tmp)
(vla-getBulge pline p)
      )
      (vla-getWidth pline p 'swid 'ewid)
      (vla-setWidth copy (vl-position p tmp) swid ewid)
    )
    (foreach prop '(Elevation     Layer     Linetype
    LinetypeGeneration     LinetypeScale
    Lineweight     Normal     Thickness
    TrueColor
   )
      (if (vlax-property-available-p pline prop)
(vlax-put copy prop (vlax-get pline prop))
      )
    )
    (setq tmp nil
  ret (cons copy ret)
    )
  )
)

;;================================================================;;

;; HighlightSegment
;; Highlight a polyline segment
;;
;; Arguments
;; pl : the polyline (vla-object)
;; par : the segment index

(defun HighlightSegment (pl par / p1 p2 n lst)
  (and
    (setq p1 (vlax-curve-getPointAtParam pl par))
    (setq p1 (trans p1 0 1))
    (setq p2 (vlax-curve-getPointAtParam pl (+ par 1)))
    (setq p2 (trans p2 0 1))
    (if (zerop (vla-getBulge pl par))
      (grvecs (list -255 p1 p2))
      (progn
(setq n 0)
(repeat 100
  (setq lst (cons (trans (vlax-curve-getPointAtParam pl (+ n par)) 0 1)
  lst
    )
n   (+ n 0.01)
  )
)
(grvecs
  (cons -255 (apply 'append (mapcar 'list lst (cdr lst))))
)
      )
    )
  )
)

;;================================================================;;

;;; Clockwise-p
;;; Returns T if p1 p2 and p3 are clockwise

(defun clockwise-p (p1 p2 p3)
  (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)

;;================================================================;;

;;; Polyarc-data
;;; Returns a list of the center, radius and angle of a 'polyarc'.

(defun polyarc-data (bu p1 p2 / ang rad cen area cg)
  (setq ang (* 2 (atan bu))
rad (/ (distance p1 p2)
       (* 2 (sin ang))
    )
cen (polar p1
   (+ (angle p1 p2) (- (/ pi 2) ang))
   rad
    )
  )
  (list cen (abs rad) ang)
)

;;================================================================;;

;;; VXV Returns the dot product of two vectors

(defun vxv (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)

;;================================================================;;

;;; ILP
;;; Returns the intersection point between a line (extended) and a plane
;;;
;;; Arguments
;;; p1 and p2 : two points defining the line
;;; org : a point on the plane
;;; nor : the plane normal

(defun ilp (p1 p2 org nor / scl)
  (setq scl (/ (vxv nor (mapcar '- p1 org))
       (vxv nor (mapcar '- p2 p1))
    )
  )
  (mapcar (function (lambda (x1 x2) (+ (* scl (- x1 x2)) x1)))
  p1
  p2
  )
)
« Last Edit: March 26, 2008, 01:40:15 PM by gile »
Speaking English as a French Frog

Serge J. Gianolla

  • Guest
Re: segment offset ?
« Reply #6 on: March 24, 2008, 10:58:55 PM »
Bravo Gilles,
Ca marche bien - surtout quand les elements sont contigus, ca reste pline apres un offset! J'ai meme pousse  :evil: jusqu'a avoir differentes epaisseurs et meme start and end widths differentes, ca respecte bien. Ai un souci quand meme, quand pline est fit ou spline, le message est que j'ai selectionne "Invalid entity".

Serge J. Gianolla

  • Guest
Re: segment offset ?
« Reply #7 on: March 25, 2008, 01:43:30 AM »
Oops,
was thrown out of texting then it was end of lunchtime.  :-o

What I was saying was:
It works very well indeed, especially if one selects contiguous elements - still a pline after offsetting! I pushed it to limits too, with different pline widths and even making sure the start and end widths to be different and there is no loss when offset. Only issue I have is when used on a curve-fit or splined polyline. I have found out since that it affects old type of plines; not when drawing a LWPline!

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #8 on: March 25, 2008, 03:19:47 AM »
Merci pour le retour, Serge

The routine doesn't treat 'old style' 2d polylines because they don't support the vla-getWidth function (non constant width) nor the vla-getBulge one if they're fitted or splined.
« Last Edit: March 25, 2008, 03:30:21 AM by gile »
Speaking English as a French Frog

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: segment offset ?
« Reply #9 on: March 25, 2008, 06:54:07 AM »
Hello gile!
I liked your idea of testing of a direction! :)
Code: [Select]
(defun clockwise-p (p1 p2 p3) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14))
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: segment offset ?
« Reply #10 on: March 25, 2008, 07:03:35 AM »
The program not always works truly...  :-(
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

dussla

  • Bull Frog
  • Posts: 254
Re: segment offset ?
« Reply #11 on: March 25, 2008, 08:39:54 AM »
really thank you for your effort

i found this lisp  for  segment line check  from other kind man lisp


(defun c:rseg ( / elst ename pt param preparam postparam pt1 pt2)
  (setq elst (entsel "\nSelect pline segment: "))
  (setq ename (car elst))
  (setq pt (cadr elst))
  (setq pt (vlax-curve-getClosestPointTo ename pt))
  (print  (setq param (vlax-curve-getParamAtPoint ename pt)) )
  (print  (setq preparam (fix param)) )
  (print  (setq postparam (1+ preparam)) )
  (setq  pt1     (vlax-curve-getPointAtParam ename preparam) )
  (setq  pt2     (vlax-curve-getPointAtParam ename postparam) )
  (redraw)
  (draw_pt pt1)
  (draw_pt pt2)
 
) ;end


(defun draw_pt (pt / rap)
(setq rap (/ (getvar "viewsize") 50))
(foreach n
(mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap)))
'((+ +) (+ -) (- +) (- -))
)
(grdraw pt n -1)
)
)



like this lisp

can you modify some  , then  your lisp  will be  perpect

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #12 on: March 25, 2008, 01:21:33 PM »
Thanks for the bug reporting Evgeniy.

I revised the code, I think it's corrected now.
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #13 on: March 25, 2008, 05:28:58 PM »
I revised the code: 'highlighting' selected segments (doesn't work very well on arcs).
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: segment offset ?
« Reply #14 on: March 26, 2008, 09:54:38 AM »
One more revision: a selected segment can be removed from the selection by clicking it again.
« Last Edit: March 26, 2008, 01:40:58 PM by gile »
Speaking English as a French Frog