hi i found this lisp .
this is kent cooper lisp , thank you
i test this lisp.
but result is other.
pls can you explain and fix ?
;; LinesRegularizeAngles.lsp [command name: LRA]
;; To Regularize all selected Lines, changing the Angle of each to the nearest
;; multiple of the specified angular increment. Rotates each Line around its
;; midpoint, to stay at "average" original location and at original length.
;;
;; Kent Cooper, November 2009
(defun C:LRA
(/ *error* cmde aunit osm blips anginc lines sstemp plpcs plpc
ln lndata lnend1 lnend2 lnmid lnang lnangnew)
;
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort"))
(princ (strcat "\nError: " errmsg))
); end if
(command)
(setvar 'aunits aunit)
(setvar 'osmode osm)
(setvar 'blipmode blips)
(setvar 'clayer curlay)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
); end defun - *error*
;
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setq
aunit (getvar 'aunits)
osm (getvar 'osmode)
blips (getvar 'blipmode)
curlay (getvar 'clayer)
anginc (getangle "\nRegularize Lines to nearest multiple of what angle? ")
); end setq
(setvar 'osmode 0)
(setvar 'blipmode 0)
(setvar 'aunits 3); radians
;
(initget "Yes No")
(if
(=
(getkword "\nExplode Polylines and process Line segments? [Y/N] <Y>: ")
"No"
); end =
(setq lines (ssget '((0 . "LINE")))); then - only Lines
(progn ; else - also Polylines, explode and add line segments to set
(setq
sstemp (ssget '((0 . "LINE,*POLYLINE")))
lines (ssadd)
); end setq
(repeat (sslength sstemp)
(setq item (ssname sstemp 0))
(ssdel item sstemp)
(if (= (cdr (assoc 0 (entget item))) "LINE")
(ssadd item lines); then - add to set of Lines
(progn; else - it's a Polyline: explode, add resulting Lines to set
(command "_.explode" item)
(setq plpcs (ssget "_P"))
(repeat (sslength plpcs)
(setq plpc (ssname plpcs 0))
(if (= (cdr (assoc 0 (entget plpc))) "LINE") (ssadd plpc lines))
(ssdel plpc plpcs)
); end repeat
); end progn
); end if
); end repeat
); end progn - else
); end if
;
(initget "Original New")
(if
(=
(getkword "\nRegularize Original lines or copies on New layer? [O/N] <O>: ")
"New"
); end =
(command
"_.layer" "_make" "ReguLines" "_color" 200 "" "" ; [change name & color number as desired]
"_.copy" lines "" '(0 0 0) '(0 0 0)
"_.chprop" lines "" "_layer" "ReguLines" ""
); end command
); end if
;
(repeat (sslength lines)
(setq
ln (ssname lines 0)
lndata (entget ln)
lnend1 (cdr (assoc 10 lndata))
lnend2 (cdr (assoc 11 lndata))
lnang (angle lnend1 lnend2)
lnmid (mapcar '/ (mapcar '+ lnend1 lnend2) '(2 2 2))
lnangnew
(if (zerop anginc)
0
(* (fix (+ (/ lnang anginc) 0.5)) anginc)
); end if & lnangnew
); end setq
(command "_.rotate" ln "" lnmid "_reference" lnang lnangnew)
(ssdel ln lines)
); end repeat
;
(setvar 'aunits aunit)
(setvar 'osmode osm)
(setvar 'blipmode blips)
(setvar 'clayer curlay)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); end defun
;
(prompt "\nType LRA to adjust Lines to Regularized Angles.")