;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; ;;;; Copyright (c) March 2005 by Takehiko Nagakura. ;;;; ;;;; All rights reserved. ;;;; ;;;; ;;;; ;;;; Do not copy, use, modify or distribute this software ;;;; ;;;; without written permission by Nagakura. Nagakura will ;;;; ;;;; not be responsible for any consequence of its use. ;;;; ;;;; ;;;; ;;;; Takehiko Nagakura (e-mail: takehiko@mit.edu) ;;;; ;;;; Massachusetts Institute of Technology ;;;; ;;;; 77 Massachusetts Ave. 10-472M, Cambridge, MA 02139 ;;;; ;;;; ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Last updated 5.01.2007 by TN ;;;; updated 3.10.2005 by TN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This program provides entity handling utility functions. ; ; Earlier versions of AutoCAD (R14 or before) may not work with these due to polyline revision. ; ; (entity_layer ent) ; Returns the layer name of the entity ; ; If ent is nil, it asks the user to pick on. ; (entity_color ent) ; Returns the color number of the entity ; ; (0 means BYBLOCK, 256 means BYLAYER) ; ; If ent is nil, it asks the user to pick on. ; (entity_type ent) ; Returns the entity's type name ; ; If ent is nil, it asks the user to pick on. ; ; (entity_vertices ent) ; Returns a list of the vertex points of the entity in WCS ; ; Works for line, arc, spline, 3dpoly, and pline. For line ; ; and arc, two endpoints are returned in a list. ; ; If ent is nil, it asks the user to pick on. ; ; (entity_center ent) ; Returns the center of the entity in WCS ; ; Works for circle, arc and ellipse. ; ; If ent is nil, it asks the user to pick on. ; ; (entity_division_points ent N) ; ; Divides the entity by an interger N and returns ; ; a list of subdivision coordinates in a point list in WCS ; ; Works for line, arc, spline, 3dpoly, and pline ; ; If ent is nil, it asks the user to pick on. ; ; (entity_intersection_points ent1 ent2 flag) ; ; Returns a list of coordinate points of intersections ; ; between two line or curve. If flag is not nil, attempts ; ; are made to extend the line and curve to make intersections. ; ; If ent1 is nil, it asks the user to pick on. ; ; If there is no intersection, it returns nil. ; ; (entlast_list) ; Returns a list of entities made after the last ; ; call to (entlast_list_init) ; ; (entlast_list_init) ; Initialize the marker for (entlast_list) (vl-load-com) ; make sure I can use vla-xxx and vlax-xxx AciveX commands. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Checks if ent is an entity made via spline, 3dpoly, pline, line, arc or circle. ; If not, returns nil. Note that "pline" command of older version of AutoCAD ; makes "POLYLINE" instead of "LWPOLYLINE". These two differ the way DXF coding ; works. So, some commands in this file may not work for older version of AutoCAD. (defun tn-curve-line-entity-kind ( ent / ekind) (if (eq (type ent) 'ENAME) (progn (setq ekind (cdr (assoc 0 (entget ent)))) (cond ((eq "SPLINE" ekind) (setq ekind "spline")) ((eq "POLYLINE" ekind) (setq ekind "3dpoly")) ((eq "LWPOLYLINE" ekind) (setq ekind "pline")) ((eq "LINE" ekind) (setq ekind "line")) ((eq "ARC" ekind) (setq ekind "arc")) ((eq "CIRCLE" ekind) (setq ekind "circle")) ((eq "ELLIPSE" ekind) (setq ekind "ellipse")) (t (setq ekind nil))) ;cond ); progn (setq ekind nil) ) ;if ekind ; this should be spline, 3dpoly, pline, line, arc, circle or nil. ) ; defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun tn-curve-line-select ( / ent ) (setq ent (car (entsel "select a curve, line or pline:"))) (if (tn-curve-line-entity-kind ent) ent ; returns the entity nil ; returns nil otherwise ) ; if ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun entity_type (ent / ekind) (if (null ent) (setq ent (car (entsel "select an object:")))) (if (eq (type ent) 'ENAME) (cdr (assoc 0 (entget ent))) nil)) (defun entity_layer (ent / ekind) (if (null ent) (setq ent (car (entsel "select an object:")))) (if (eq (type ent) 'ENAME) (cdr (assoc 8 (entget ent))) nil)) ; color 0 means byblock ; 256 means bylayer (defun entity_color (ent / ekind col) (if (null ent) (setq ent (car (entsel "select an object:")))) (setq col nil) ; init (if (eq (type ent) 'ENAME) (progn (setq col (cdr (assoc 62 (entget ent)))) (if (null col) (setq col 256))); progn ) ;if col) ; (defun entity_layer_color (layer-name) "not implemented") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun entity_center (ent / ekind pt) (if (null ent) (setq ent (tn-curve-line-select))) (setq ekind (tn-curve-line-entity-kind ent)) ;(print ekind) (cond ((or (eq ekind "circle") (eq ekind "arc") ) (setq pt (cdr (assoc 10 (entget ent)))) ; this is in OCS (setq pt (trans pt ent 0)) ) ; convert to WCS ((eq ekind "ellipse") ; center is WCS (setq pt (cdr (assoc 10 (entget ent)))) ) ( t (setq pts nil)) ) ;cond pt ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun entity_vertices (ent / ekind pts pts2 zcoord obj pt pt2) (if (null ent) (setq ent (tn-curve-line-select))) (setq ekind (tn-curve-line-entity-kind ent)) ;(print ekind) (cond ( (eq ekind "spline") (setq pts (mapcar 'cdr ; dxf code 11 of a spline seems to be always in WCS (vl-remove-if-not '(lambda (a) (= 11 (car a))) (entget ent))) ) ; setq ) ( (eq ekind "pline") ; dxf code 10 of a lwpolyline is in OCS and 2D point (setq pts (vl-remove-if-not '(lambda (a) (= 10 (car a))) (entget ent))) (setq zcoord (cdr (assoc 38 (entget ent)))) ; z-elevation from OCS plane (setq pts ; convert from OCS to WCS (mapcar '(lambda (pt) (trans (append (cdr pt) (list zcoord)) ent 0)) pts)) ) ( (eq ekind "3dpoly") (setq obj (vlax-ename->vla-object ent)) (setq pts (vla-get-coordinates obj)) ; coordinates are 3D in WCS (setq pts (vlax-safearray->list (vlax-variant-value pts))) ; this forms x1 y1 z1 x2 y2 z2 .... xN yN zN (setq pts (reverse pts) pts2 nil pt nil) ; a trick (while pts (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get z coord (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get y coord (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get x coord (setq pts2 (cons pt pts2) pt nil) ); while (setq pts pts2) ) ( (or (eq ekind "line") (eq ekind "arc")) (setq obj (vlax-ename->vla-object ent)) (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-startPoint obj)))) (setq pt2 (vlax-safearray->list (vlax-variant-value (vla-get-endPoint obj)))) (setq pts (list pt pt2)) ) ( t (setq pts nil)) ) ;cond pts ) ;| ; This one uses ActiveX object and also works, too. (defun tn-pline->wpts (ent / obj pts wpts zcoord) (setq obj (vlax-ename->vla-object ent)) (setq pts (vla-get-coordinates obj)) ; coordinates are 2D in OCS (setq pts (vlax-safearray->list (vlax-variant-value pts))) ; x1 y1 x2 y2 .... xN yN (setq pts (reverse pts)) ; a trick (setq wpts nil) ; init (setq zcoord (vla-get-elevation obj)) ; z-elevation from OCS plane (while pts (setq pt (list zcoord)) (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get y coord (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get x coord (setq wpts (cons pt wpts)) ); while (setq wpts (mapcar '(lambda (pt) (trans pt ent 0)) wpts)) ; convert from OCS to WCS wpts ) |; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; returned points are in WCS (defun entity_division_points (ent n / ends elast pts ss) (if (null ent) (setq ent (tn-curve-line-select))) (if ent (progn (setq ends (entity_vertices ent)) (setq ends (list (car ends) (last ends))) )) (if ends (progn (command "osnap" "off") (command "point" (list 0 0 0)) ; I do this to skip subentities (setq elast (entlast)) ; current last main entity in the database which is the point (setq ss (ssadd)) (ssadd elast ss) ; this will be erased later (command "divide" ent n) (setq pts nil) ; initialize (setq elast (entnext elast)) ; first point created (while elast (setq pts (cons elast pts)) (ssadd elast ss) (setq elast (entnext elast)) ) ; pts is list of the new division points excluding the endpoints ; dxf code 10 of a point is always in WCS (setq pts (mapcar '(lambda (pt) (cdr (assoc 10 (entget pt)))) pts)) (setq pts (append (list (cadr ends)) pts (list (car ends)))) (command "erase" ss "") ;(print pts) ;(3dpoly_from_points (mapcar '(lambda (p) (trans p 0 1)) pts)) pts ) (print "Selected object is not valid") ) ; if ) ; defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; returned points are in WCS ; if flag is not nil, two objects are extended for attempting to intersect (defun entity_intersection_points (ent1 ent2 flag / pts pt pts2) (if flag (setq flag acExtendBoth) (setq flag acExtendNone)) (if (null ent1) (progn (setq ent1 (tn-curve-line-select)) (if ent1 (setq ent2 (tn-curve-line-select)) )); progn ) ;if (if (and (tn-curve-line-entity-kind ent1) (tn-curve-line-entity-kind ent2)) (progn (setq pts (vla-intersectwith (vlax-ename->vla-object ent1) ; use ActiveX intersection tool here! (vlax-ename->vla-object ent2) flag)) (setq pts (vlax-variant-value pts)) (if (= (vlax-safearray-get-u-bound pts 1) -1) ; this seesm the only way to tell (setq pts nil) ; no intersection found (progn (setq pts (vlax-safearray->list pts)) (setq pt nil pts2 nil) (setq pts (reverse pts)) ; trick (while pts ; this forms x1 y1 z1 x2 y2 z2 .... xN so group them per point (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get z coord (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get y coord (setq pt (cons (car pts) pt)) (setq pts (cdr pts)) ;get x coord (setq pts2 (cons pt pts2)) (setq pt nil) ); while (setq pts pts2) )); if );progn );if pts) (defun entlast_list_init () (setq *entlast_list_marker* (entlast)) ) (entlast_list_init) ; initialize once when this file loads ; if drawing has no entities (such as newly created one), ; *entlast_list_marker* becomes nil (defun entlast_list ( / elist ent) (setq elist nil) (if (null *entlast_list_marker*) ; no entities in the drawing at the time of initialization (setq ent (entnext)) ; get current first entity in the database (setq ent (entnext *entlast_list_marker*)) ; get first entity after the marked ) ;if (while ent (setq elist (cons ent elist)) (setq ent (entnext ent)) );while elist ) ;| (defun c:yy () (command "osnap" "off") (setq pts (entity_intersection_points nil nil nil)) (mapcar '(lambda (p) (command "line" p '(0 0 0) "")) pts)) (defun c:xx ( / pts) (setq pts (entity_division_points nil 5)) (mapcar '(lambda (p) (command "line" p '(0 0 0) "")) pts)) |;