Craig: In your workplace I would think BOTH ends of a line need to be
snapped. I think I see an account for only the starting point, but not the
ending point. (assoc 11 dxf_ent) ?
--
_________________________
Bill DeShawn
bdeshawn@nospamsterling.net
http://my.sterling.net/~bdeshawn
"CraigV (fs)" wrote in message
news:5699580@discussion.autodesk.com...
I needed a routine to clean up some walls which weren't drawn accurately. I
prefer to draw all walls to a SNAP unit, like 1" or 1/2". I used this
routine to clean up some walls that we not draw accurately - somebody set
the OTRACK polar angle settings "Increment angle" to "30.00000003". That
really messes up a drawing... Nothing was orthagonal to the original
drawing...
;; Reply From: bruno.valsecchi
;; Date: Nov/09/06 - 13:15 (GMT)
;; modified 2007-08-23 by Craig Vaughn to include ADT "AEC_WALL" objects
(defun round_number (xr n /)
(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:ObjectSnapCleanup (/ js n_count ent dxf_ent dxf_lst ACAD
MODELSPACE P P1 P2 P1-ORIG
P2-ORIG THISDRAWING WALLOBJ X Z)
(setq js
(ssget
'((0
.
"AEC_WALL,FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,
POINT,SHAPE,SOLID,TRACE")))
n_count -1)
(cond
(js
(setvar "cmdecho" 0)
(setq acad (vlax-get-acad-object)
thisDrawing (vlax-get acad "activedocument")
modelspace (vlax-get thisDrawing "modelspace")
)
(command "_.undo" "_group")
(while (setq ent (ssname js (setq n_count (1+ n_count))))
(setq dxf_ent (entget ent))
(cond
((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
(setq dxf_lst (cdr dxf_ent)
dxf_ent (list (car dxf_ent)))
(while (cdr dxf_lst)
(if (eq 10 (caar dxf_lst))
(setq dxf_ent
(cons (cons 10
(mapcar '(lambda (x p) (round_number x (/ 1 p)))
(cdar dxf_lst)
(getvar "SNAPUNIT")))
dxf_ent))
(setq dxf_ent (cons (car dxf_lst) dxf_ent))
)
(setq dxf_lst (cdr dxf_lst))
)
(setq dxf_ent (reverse dxf_ent))
)
((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
(while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar
dxf_ent))))))
"VERTEX")
(setq dxf_ent
(subst (cons 10
(mapcar '(lambda (x p) (round_number x (/ 1 p)))
(cdr (assoc 10 dxf_ent))
(append (getvar "SNAPUNIT")
(list (car (getvar "SNAPUNIT"))))))
(assoc 10 dxf_ent)
dxf_ent))
(entmod dxf_ent)
)
)
((eq (cdr (assoc 0 dxf_ent)) "AEC_WALL")
(setq wallobj (vlax-ename->vla-object ent))
(setq
p1 (vlax-get wallobj 'StartPoint)
p2 (vlax-get wallobj 'EndPoint)
)
(if p1
(progn
(setq p1 (lisp-value p1)
p1-orig p1
z (cddr p1))
(setq p1 (mapcar '(lambda (x p) (round_number x (/ 1 p)))
p1
(getvar "SNAPUNIT")))
(setq p1 (append p1 z))
)
)
(if p2
(progn
(setq p2 (lisp-value p2)
p2-orig p2
z (cddr p2))
(setq p2 (mapcar '(lambda (x p) (round_number x (/ 1 p)))
p2
(getvar "SNAPUNIT")))
(setq p2 (append p2 z))
)
)
(vlax-put wallobj 'startpoint p1)
(vlax-put wallobj 'endpoint p2)
(setq dxf_ent nil)
)
(T
(foreach
n
dxf_ent
(if (member (car n) '(10 11 12 13 40))
(if (listp (cdr n))
(setq dxf_ent
(subst
(cons (car n)
(mapcar '(lambda (x p) (round_number x (/ 1 p)))
(cdr n)
(append (getvar "SNAPUNIT")
(list (car (getvar "SNAPUNIT"))))))
(assoc (car n) dxf_ent)
dxf_ent))
(setq dxf_ent
(subst
(cons (car n)
(round_number (cdr n) (/ 1 (car (getvar "SNAPUNIT")))))
(assoc (car n) dxf_ent)
dxf_ent))
)
)
)
)
)
(if dxf_ent
(progn (entmod dxf_ent) (entupd ent)))
)
(command "_.undo" "_end")
(setvar "cmdecho" 1)
(princ (strcat "\n" (itoa n_count) " transformed objects (s)."))
)
(T (princ "\nNo found valid object ."))
)
(prin1)
)
(defun lisp-value (v) ; the Holy Graal of vla->lisp conversion? 😉
;; Copyright 2002 Vladimir Nesterovsky.
;; Free for use by any commercial entity with
;; less then $100 million annual revenue.
(cond
((= (type v) 'variant)
(lisp-value (variant-value v)))
((= (type v) 'safearray)
(mapcar 'lisp-value (safearray-value v)))
(T v)
)
)
;;Frank Oquendo acadx.dwg
(defun listToVariantArray (lst varType)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
varType
(cons 0 (1- (length lst)))
)
(mapcar
'(lambda (x)
(cond
((= (type x) 'list)
(vlax-safearray-fill
(vlax-make-safearray
(if (apply '= (mapcar 'type x))
(cond
((= (type (car x)) 'REAL) vlax-vbDouble)
((= (type (car x)) 'INT) vlax-vbInteger)
((= (type (car x)) 'STR) vlax-vbString)
)
vlax-vbVariant
)
(cons 0 (1- (length x)))
)
x
)
)
((= (type x) 'ename)
(vla-get-objectid (vlax-ename->vla-object x))
)
(t x)
)
)
lst
)
)
)
)