Hi gentle people
A little while back I found a great lisp routine for wiring diagrams and schedules. It puts all my entities on the snap that's set in the drawing. The problem is that it doesn't seem to do what it should to my attributes. I tried a few things, but I'm not very good at lisp (I'm more at home in VB).
Perhaps if someone here has a look that person can se what's wrong. I hope so anyway, and of course I hope that person wil be willing to share that insight. Here goes:
Code:(defun round_number (xr n /) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))) (defun c:O2S (/ 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,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 ) ) ) )


Reply With Quote