[编程交流] autolisp多段线计算

; copy object using entmake where is it put it here
(command "_.fillet" "_r" 0.0 "_.fillet" "_polyline" (entlast))

; pline co-ords example
; By Alan H
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq obj (entmake (entget (car (entsel))))) ; makes a copy of the entity
(command "_.fillet" "_r" 0.0 "_.fillet" "_polyline" (entlast))
;(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(setq co-ords (getcoords (car (entlast)))) ;changed for this post 
(co-ords2xy) ; list of 2d points making pline
; do your thing here re measurements
(command "_.Erase" "" obj)

[color=#8b4513]; eoh - entity / vla-object / handle [b][color=BLACK]([/color][/b] MultiSegment polyline [b][color=BLACK])[/color][/b][/color]
[color=#8b4513]; mDeg - if T returns degrees else radians[/color]
[color=#8b4513]; Returns: assoc list of dotted pairs, where each item is: [b][color=BLACK]([/color][/b]< Length > . < Angle >[b][color=BLACK])[/color][/b] ; for every segment of the curve[/color]
[b][color=BLACK]([/color][/b]defun PlineInfo [color=#8b4513];| Written by: Grrr, credits to: Lee Mac, Tharwat |; [b][color=FUCHSIA]([/color][/b] eoh mDeg / handobj GetLength RTD eo objs Lst [b][color=FUCHSIA])[/color][/b][/color]
[b][color=FUCHSIA]([/color][/b]defun handobj [b][color=NAVY]([/color][/b] hand [b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]vlax-ename->vla-object [b][color=MAROON]([/color][/b]handent hand[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]defun GetLength [b][color=NAVY]([/color][/b] eo / prm [b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]vl-catch-all-error-p [b][color=BLUE]([/color][/b]setq prm [b][color=RED]([/color][/b]vl-catch-all-apply 'vlax-curve-GetEndParam [b][color=PURPLE]([/color][/b]list eo[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]vlax-curve-getDistAtParam eo prm[b][color=MAROON])[/color][/b]
        [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]defun RTD [b][color=NAVY]([/color][/b]a[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]/ [b][color=MAROON]([/color][/b]* a 180[b][color=MAROON])[/color][/b] PI[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]cond 
        [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]eq 'VLA-OBJECT [b][color=GREEN]([/color][/b]type eoh[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] eoh[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]eq 'ENAME [b][color=GREEN]([/color][/b]type eoh[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq eoh [b][color=GREEN]([/color][/b]vlax-ename->vla-object eoh[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]eq 'STR [b][color=GREEN]([/color][/b]type eoh[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq eoh [b][color=GREEN]([/color][/b]handobj eoh[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]T [b][color=MAROON]([/color][/b]setq eoh nil[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]if eoh
        [b][color=NAVY]([/color][/b]progn
                [b][color=MAROON]([/color][/b]setq objs [b][color=GREEN]([/color][/b]vlax-invoke eoh 'Explode[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]setq Lst
                        [b][color=GREEN]([/color][/b]mapcar 'cons
                                [b][color=BLUE]([/color][/b]mapcar 'GetLength objs[b][color=BLUE])[/color][/b]
                                [b][color=BLUE]([/color][/b]mapcar '[b][color=RED]([/color][/b]lambda [b][color=PURPLE]([/color][/b]x / a[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq a [b][color=TEAL]([/color][/b]angle [b][color=OLIVE]([/color][/b]vlax-get x 'EndPoint[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]vlax-get x 'StartPoint[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]if mDeg [b][color=TEAL]([/color][/b]RTD a[b][color=TEAL])[/color][/b] a[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] objs[b][color=BLUE])[/color][/b]
                        [b][color=GREEN])[/color][/b]
                [b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]mapcar 'vla-Delete objs[b][color=MAROON])[/color][/b]
        [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
Lst
[b][color=BLACK])[/color][/b][color=#8b4513];| defun PlineInfo |; [b][color=BLACK]([/color][/b]or vlax-get-acad-object [b][color=FUCHSIA]([/color][/b]vl-load-com[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b][/color]

(setq tempobj (entlast))
... do your thing
(command "erase" tempobj "")