this code is rectify code
Using lots of great friends code, I ended up with the following code:
but there is problem
0 ,enter rg9 command
1. select objects
2. enter 45 angel
if i 1 object select , work some good result
but tow error
a. mulit select object error
b, duplicated object
i seek error for a long time, but my limit
pls help again
;; Outline Objects - Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel - [sel] Selection Set to outline
;; Returns: [sel] A selection set of all objects created
(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp )
(setq cl (getvar "clayer"))
(command "-Layer" "m" "_boe" "c" "32" "_boe" "")
(command "-layer" "s" "_boe" "")
(if (setq box (LM:ssboundingbox sel))
(progn
(setq app (vlax-get-acad-object)
dis (/ (apply 'distance box) 20.0)
lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
are (apply '* (apply 'mapcar (cons '- (reverse lst))))
dis (* dis 1.5)
ent
(entmakex
(append
'( (000 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(090 . 4)
(070 . 1)
)
(mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
'( (caar cadar)
(caadr cadar)
(caadr cadadr)
(caar cadadr)
)
)
)
)
)
(apply 'vlax-invoke
(vl-list* app 'zoomwindow
(mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))
)
)
(setq cmd (getvar 'cmdecho)
enl (entlast)
rtn (ssadd)
)
(while (setq tmp (entnext enl)) (setq enl tmp))
(setvar 'cmdecho 0)
(command
"_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
(trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""
)
(while (< 0 (getvar 'cmdactive)) (command ""))
(entdel ent)
(while (setq enl (entnext enl))
(if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
(equal (vla-get-area obj) are 1e-4)
)
(entdel enl)
(ssadd enl rtn)
)
)
(vla-zoomprevious app)
(setvar 'cmdecho cmd)
rtn
)
)
(setvar "clayer" cl)
)
;; Selection Set Bounding Box - Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
(defun dtr (a)
(* pi (/ a 180.0))
)
(defun rtd (a)
(/ (* a 180) pi)
)
(defun met2 ()
(setvar "CMDECHO" 0)
; change direction to 0 and clockwise to n
(command "units" "" "" "" "" "0" "n")
(prompt "\n East = 0")
(setvar "CMDECHO" 1)
(princ)
)
(defun C:rg9 ( / acadobj activeundo adoc coords del dis getcoords i len ss ln entang wid rangle)
(VL-LOAD-COM)
;;RAD TO DEG AND DEG TO RAD
(DEFUN RTD (X) ;_define RADIAN TO DEGREE function
(/ (* X 180.0) PI)
) ;_ DEFUN ADD by DEVITG
;; MULTIPLY THE RAD ING BY 180 AND DIVIDE IT BY PI
(defun getcoords (ln) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ln))))
(defun lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))))
(setq acadobj (vlax-get-acad-object)
adoc (vla-get-ActiveDocument acadobj)
activeundo nil)
(setvar "orthomode" 0 )
(setvar "osmode" 0)
(command "_.undo" "_begin")
(setq
aunit (getvar 'aunits)
osm (getvar 'osmode)
blips (getvar 'blipmode)
curlay (getvar 'clayer)
)
(setvar 'osmode 0)
(setvar 'blipmode 0)
(setvar 'aunits 3); radians
(if ( not anginc ) (setq anginc 45 ) )
(setq btemp-wi (getint (strcat "\n angle <" (rtos anginc) ">:")) )
(if btemp-wi (setq anginc btemp-wi))
(setq anginc (dtr anginc) )
(setq d 2000)
(setq lines (ssadd) )
(command "-Layer" "m" "newrect" "c" "150" "newrect" "")
(command "-layer" "s" "newrect" "")
(setq ss (ssget '((0 . "LWPOLYLINE") )))
(repeat (setq i (sslength ss))
(setq entang (ssname ss (setq i (1- i))) )
(setq coords (getcoords entang ))
(setq ent (ssname ss (setq i (1- i))))
(setq dis (mapcar 'distance coords (cdr coords)))
(setq rangle (mapcar 'angle coords (cdr coords)))
(cond
((< (nth 0 dis) (nth 1 dis)) (setq wid (nth 0 dis)) (setq len (nth 1 dis)) (setq rect-angle (rtd (nth 1 rangle))) )
((>= (nth 0 dis) (nth 1 dis)) (setq wid (nth 1 dis)) (setq len (nth 0 dis)) (setq rect-angle (rtd (nth 0 rangle))) )
)
; my adds
(SETQ MID-PT-xy (MAPCAR '* '(0.5 0.5 0.8) (MAPCAR '+ (nth 0 coords) (nth 2 coords))))
(setq MID-PT-x (nth 0 MID-PT-xy))
(setq MID-PT-y (nth 1 MID-PT-xy))
;end my adds
(setvar 'aunits 0); radians
(command "rotate" entang "" "_non" MID-PT-xy (- 360 rect-angle ) )
(setvar 'aunits 3); radians
(command "_.explode" entang)
(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
(setq sslist (ssadd))
(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
(setq lndata (subst (cons 10 (polar lnend2 lnang d)) (assoc 10 lndata) lndata)
lndata (subst (cons 11 (polar lnend1 (+ lnang pi) d)) (assoc 11 lndata) lndata)
)
(entmod lndata)
(setvar 'osmode 0)
(setvar 'aunits 3);
(command "_.rotate" ln "" lnmid "_reference" lnang lnangnew)
(setvar 'aunits 3);
(ssadd ln sslist)
(ssdel ln lines)
;;(LM:outline sel)
(LM:outline sslist)
); end repeat
(setq newnet (ssget "_l"))
(setvar 'aunits 0);
(command "rotate" newnet "" "_non" MID-PT-xy (+ 360 rect-angle ) )
(command "_erase" plpcs "")
) ;_ repeat
(command "_.undo" "_end")
)
