offset a 3d polyline

Code Red > AutoLISP (Vanilla / Visual)

(1/1)

csgoh:
I have some problem with this fucntion which offsets a line,lwpolyline or a 3dpolyline and adds a constant value to its z coords. The problem is that sometimes its ok and sometimes not ok when it comes to a 3dpolyline whereby the offseted line is truncated. Looking at the lisp, it seems that the offseted lwpolyline has bulges which is not supposed to be. Any help is much appreciated.

--- Code: ---(defun wg:UndoCounter()
(if (= UndoCounter 0)
(progn
;(dos_beep 3)
(alert "There is nothing to undo." )
)
(progn
(setq UndoCounter (1- UndoCounter))
(vl-cmdf "undo" 1)
(if UndoCounterList
(setq UndoCounterList (reverse (cdr (reverse UndoCounterList))))

)

)
);if
); UndoCounter

(defun getSegment (obj pt ucs-number / cpt eParam stParam)
(cond
((= (vlax-get-Property obj 'objectName) "AcDbLine")
(setq eParam (vlax-curve-getEndParam obj)
stParam (vlax-curve-getStartParam obj)
)
(list (vlax-curve-getPointAtParam obj stParam)
(vlax-curve-getPointAtParam obj eParam))
)

((setq cpt (vlax-curve-getClosestPointTo obj pt))
(setq eParam (fix (vlax-curve-getEndParam obj)))

(if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj
cpt))))
(setq stParam (1- stParam))
(setq eParam (1+ stParam))
) ;IF
(list (vlax-curve-getPointAtParam obj stParam)
(vlax-curve-getPointAtParam obj eParam))
)
) ;COND
) ;GETSEGMENT

(defun ClockWise? ( Coords / I sum p1 p2 p3 )
(setq i 1
sum 0.0
)
(repeat (- (length coords) 2)
(setq p1 (nth (1- i) coords)
p2 (nth i coords)
i (1+ i)
p3 (nth i coords)
); delete later and (setq
(setq sum (+ sum (@delta (angle p1 p2)(angle p2 p3))))
)
sum
);ClockWise

(defun @delta (a1 a2)
(cond
((> a1 (+ a2 pi))
(setq a2 (+ a2 2pi))
)
((> a2 (+ a1 pi))
(setq a1 (+ a1 2pi))

)
)

(- a2 a1)
);@delta

(defun wg:VariantArrayToList ( Arr / TmpVal)
(setq TmpVal (vlax-variant-value Arr))

(if (safearray-value Tmpval)
(vlax-safearray->list Tmpval)
'()
)

);wg:VariantArrayToList

(defun wg:3DList->2DVariant-List(coordlst / calist )
; (setq calist nil)
; (foreach n coordlst
; (setq calist (append calist (list(car n)) (list (cadr n)) ))
;);foreach
; calist
(apply 'append (mapcar '3dpoint->2dpoint coordlst))
);wg:3DList->2DVariant-List

(defun ListToSafearray (symVariableType lstValues / safValues)
(setq safValues (vlax-make-safearray symVariableType
(cons 0 (1- (length lstValues)))))
(vlax-safearray-fill safValues lstValues)
) ;listToSafeArray

;; Function originated by Ken Alexander (03-05-03)
;; that is 10X faster than my @cv_parse_list,
;; to group data into (x y z )list triplets.
;; Thanks, Ken!
;;
(defun @cv_triple_up (old / new)
(while
(setq new (cons (list (car old)(cadr old)(caddr old)) new)
old (cdddr old)
)
)
(reverse new)
)

;; Function originated by Ken Alexander (03-05-03)
;; that is 10X faster than my @cv_parse_list,
;; to group data into (x y) doubles list.
;; Thanks, Ken!
;;
(defun @cv_double_up (old / new)
(while
(setq new (cons (list (car old)(cadr old)) new)
old (cddr old)
)
)
(reverse new)
)

(defun c:OFL ( /
aNtt TypeObjs_List UndoCounter M+Corr
offset_dist offsetPosition AllCoords-List input? aObj offsetObj z-coord NoOffset
PosOrNeg? PosOrNeg-List dist? N
Current_UCS World_UCS undo-mark dLayer
CanOffset? Baseline-list Z-Coords-List distUnit
distMeas distMeas? NEWBIES ELAST
)
(setvar "osmode" 0)
(setq aNtt T
TypeObjs_List (list "AcDbLine" "AcDb3dPolyline" "AcDbPolyline")
UndoCounter 0
M+Corr 0.000
Offset_dist 1.000
NoOffset 1
distUnit 1.000
distMeas "Meter"
; Current_UCS (wg:setucsname (getvar "ucsorg") (getvar "ucsxdir")
; (getvar "ucsydir") "WGUCS_Temp" nil)
; World_UCS (wg:setucsname '(0.0 0.0 0.0) '(1.0 0.0 0.0)
; '(0.0 1.0 0.0) "WGUCS_World" T)

)
(setq GB:acadobj (vlax-get-acad-object)
;; acad Object
GB:ActivedocumentObj (vla-get-Activedocument GB:acadobj)
;;
;; IAcadDocument Object
;;

;; the current dwg
;;
;; IAcadModelspace Collection
;;
GB:mSpace (vla-get-ModelSpace GB:ActivedocumentObj)
;; the modelspace collection
)
(while aNtt
(initget "Undo")
(setq AllCoords-List '()
aNtt (entsel (strcat "\nUndo [" (itoa UndoCounter)
"] <Select a line> ")))
(cond
((= aNtt "Undo")
(wg:UndoCounter)
); Undo

((not aNtt) ; no selection
(princ)
); exit

(T
(setq TypeObj (vlax-get-Property
(setq aObj (vlax-ename->vla-object (car aNtt)))
'ObjectName))
(if (member TypeObj TypeObjs_List)
(progn
(initget 1) ; no enter
(setq offsetPosition (getpoint "\nSelect point on side to offset: "))
(initget 6) ; no 0.00 and negative offset
(setq input? (getreal (strcat "\nEnter offset dist <"
(rtos offset_dist 2 3) "> ")))
(if (not input?)
(setq offset_dist offset_dist)
(setq offset_dist input?)
)
(initget "Meter Feet Ling")
(setq distMeas? (getkword (strcat "Meter/Feet/Ling <" distMeas "> "
)))
(cond
((= distMeas? "Meter")
(setq distMeas "Meter"
distUnit 1.000
)
);meter
((= distMeas? "Feet")
(setq distMeas "Feet"
distUnit 0.3048
)
);Feet
((= distMeas? "Ling")
(setq distMeas "Ling"
distUnit 0.201168
)
);meter
);cond
(if (not input?)
(setq offset_dist (* distUnit offset_dist))
(setq offset_dist (* distUnit input?))
)
(initget 6) ; no 0.00 and negative NoOffset
(setq input? (getint (strcat "\nEnter number of offsets <"
(itoa NoOffset) "> ")))
(if (not input?)
(setq Nooffset NoOffset)
(setq Nooffset input?)
)

(setq input? (getreal (strcat "\nEnter M+ RL <" (rtos M+corr 2 3) "> ")))
(if (not input?)
(setq M+Corr M+Corr)
(setq M+Corr input?)
)
(undobegin)
(setq undo-mark T)
(cond
((= (vlax-get-Property aObj 'objectName) "AcDbLine")
(setq n 1)
(repeat NoOffset
(command "offset" (* n offset_dist)
(vlax-vla-object->ename aObj) offsetPosition "")

(if (entlast)
(progn
(setq offsetObj (vlax-ename->vla-object (entlast)))
(vlax-put Obj 'StartPoint
(ZZeroCoord (vlax-get offsetObj 'StartPoint) M+corr))
(vlax-put Obj 'EndPoint
(ZZeroCoord (vlax-get offsetObj 'EndPoint) M+corr))
(vlax-put-Property offsetObj 'Layer dLayer)
(vlax-release-object offsetObj)
)
);if
(setq n (1+ n))
)
);LINE

((= (vlax-get-Property aObj 'objectName) "AcDbPolyline")
(setq n 1)
(repeat NoOffset
(command "offset" (* n offset_dist)
(vlax-vla-object->ename aObj) offsetPosition "")

(if (entlast)
(progn
(setq offsetObj (vlax-ename->vla-object (entlast)))
(setq z-coord (vlax-get-Property offsetObj 'Elevation))
(vlax-put-property offsetObj 'Elevation (+ M+corr z-coord))
(vlax-put-Property offsetObj 'Layer dLayer)
(vlax-release-object offsetObj)
(setq n (1+ n))
);progn
(progn
(alert (strcat "Cannot offset at dist\n"
(rtos (* n dist?) 2 3)))
(setq n (1+ n))
)
);if

)
);LWPOLYLINE

((= (vlax-get-Property aObj 'objectName) "AcDb3dPolyline")
(setq AllCoords-List (@cv_triple_up
(wg:VariantArrayToList (vlax-get-Property aObj 'Coordinates)))
;create a list of M=coord & z-coord
Z-Coords-List (mapcar 'list
;add the Mcorr to the z-coord
(mapcar '(lambda(x) (+ x M+Corr))
;z-coord of the vertices of 3dpolyline
(mapcar 'last allcoords-list))
)

dLayer (vlax-get-Property aObj 'Layer)
)
;; create a lwpolyline as the baseline for offset purpose
(setq baselineObj (vla-AddLightWeightPolyline GB:mSpace
(listtoSafeArray 5 (wg:3Dlist->2DVariant-List AllCoords-List))
))
(setq n 1)
(repeat NoOffset
;offset the lwpolyline baseline
(command "offset" (* n offset_dist)
(vlax-vla-object->ename baselineObj) offsetPosition "")
(if (entlast)
(progn
;;
;; the newly created offset line consists of bulges which are not supposed
;; to be
;;
(setq offsetObj (vlax-ename->vla-object (entlast)))
;get the coords of the offset lwpolyline
; append the z-coords to the offsetObj-list
(setq offsetObj-List (mapcar 'append
; vertices of lwpolyline
(@cv_double_up (wg:VariantArrayToList
(vlax-get-Property offsetObj 'Coordinates)))
; the M+corr & original z-coord of the polyline
z-coords-list
))
; (vla-delete offsetObj) ; delete the lwpolyline
(setq offsetObj (wg:Draw3dPolyLines GB:mSpace
offsetObj-list dLayer))
);progn
);if
(setq n (1+ n))
);repeat
(vla-delete baselineObj)
);3dPOLYLINE
);cond
(undoend)
(setq UndoCounter (1+ UndoCounter))
; (vla-ZoomExtents GB:acadObj)
);progn
(progn
(alert "Pls select a LINE/LWPOLYLINE/3dPOLYLINE only")
)
);if
); object selected
);cond
);while
(princ)
);C:OFL

(defun undobegin ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
(vla-StartUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
) ;undobegin

(defun undoend ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
) ; undoend

(defun 3dpoint->2dpoint (3dpt)
(list (car 3dpt) (cadr 3dpt))

)
(defun wg:Draw3dPolyLines ( Space? CoordsList dlayer / )
(setq CoordsList (wg:3DList->3DVariant-List
(mapcar '(lambda(x) (trans x 1 0)) coordslist)
T)
CoordsList (vlax-make-variant (listToSafeArray 5 CoordsList))
)
(vla-put-Layer
(vlax-invoke-method Space? 'Add3dPoly CoordsList)
dlayer
)
); wg:Draw3dPolyLines

(defun wg:3DList->3DVariant-List(coordlst z-value? / calist )
(setq calist nil)
(foreach n coordlst
(if z-value?
(setq calist (append calist (list(car n)) (list (cadr n))(list (caddr n))))
(setq calist (append calist (list(car n)) (list (cadr n))(list 0.00)))
)
);foreach
calist
);wg:3DList->3DVariant-List

--- End code ---

* Command: li LIST
Select objects: Specify opposite corner: 2 found

Select objects:

POLYLINE Layer: "CDRAIN"
Space: Model space
Handle = 633
Open space
Points not coplanar. No area calculated.
length 67.2241

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 634
Space
at point, X=7697.3835 Y=-17494.3962 Z= 38.8240

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 635
Space
at point, X=7705.4501 Y=-17513.9060 Z= 38.9400

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 637
Space
at point, X=7710.4379 Y=-17527.9404 Z= 38.9470

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 638
Space
at point, X=7715.4256 Y=-17544.8701 Z= 38.9620
Press ENTER to continue:

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 639
Space
at point, X=7715.4274 Y=-17544.8762 Z= 39.0490

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 63A
Space
at point, X=7719.2014 Y=-17557.7162 Z= 39.1220

VERTEX Layer: "CDRAIN"
Space: Model space
Handle = 63B
Space
at point, X=7719.2019 Y=-17557.7178 Z= 39.0240

END SEQUENCE Layer: "CDRAIN"
Space: Model space
PlotStyleName: ByLayer
Handle = 636

LWPOLYLINE Layer: "CDRAIN"
Space: Model space
Handle = 632
Open
Constant width 0.0000
area 65.2761
length 99.2753

at point X=7697.3835 Y=-17494.3962 Z= 0.0000
Press ENTER to continue:
at point X=7705.4501 Y=-17513.9060 Z= 0.0000
at point X=7710.4379 Y=-17527.9404 Z= 0.0000
at point X=7715.4256 Y=-17544.8701 Z= 0.0000
bulge -0.0002
center X=7705.8332 Y=-17547.6961 Z= 0.0000
radius 10.0000
start angle 73d35'4"
end angle 73d37'14"
at point X=7715.4274 Y=-17544.8762 Z= 0.0000
at point X=7719.2014 Y=-17557.7162 Z= 0.0000
bulge 0.0000
center X=7709.6072 Y=-17560.5361 Z= 0.0000
radius 10.0000
start angle 73d37'14"
end angle 73d37'50"
at point X=7719.2019 Y=-17557.7178 Z= 0.0000
at point X=7725.0472 Y=-17577.6177 Z= 0.0000
at point X=7729.1469 Y=-17588.3496 Z= 0.0000

*
what could be wrong?
thanks

Navigation

[0] Message Index

Go to full version