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.
(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
- 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