+ Reply to Thread
Results 1 to 6 of 6
  1. #1
    Full Member
    Using
    not specified
    Join Date
    Jul 2006
    Location
    Hyderabad
    Posts
    84

    Default checking the polylines

    Registered forum members do not see this ad.

    hi everybody,
    i had three polyline layers(route, trail and junction). i want 2 find out whether trail or junction layer is missing beneath the route layer. for this, i had written one lisp program which is working fine ,but its taking time. i want 2 simplify that .
    the logic i had used for this is
    - i had collect the vertex of route layer and stored as list.
    - using repeat loop for the length of list.
    - capturing trail or junction for each coordinates and find out the starting and ending point of the features.
    - place a circle at the starting and endig point of trail or junction which is below the route.
    - go to the starting point and the ending point of the route and check for the contintuity . if there is no continutiy means erase the circle.

    i had attach the sample drawings and the lisp program. can anyone help me 2 simplify the program.

    regards
    vivek
    Attached Files

  2. #2
    Senior Member kpblc's Avatar
    Using
    AutoCAD 2005
    Join Date
    May 2006
    Location
    Russia, St-Petersburg
    Posts
    358

    Default

    I didn't test it quietly:
    Code:
    (defun test (/			      adoc
    	     lst_layer		      loc:getkword
    	     rt_lay		      thr_lay
    	     jn_lay		      _kpblc-conv-selset-to-ename
    	     lst_vertex		      _kpblc-list-dublicates-remove
    	     _kpblc-conv-ent-to-ename _kpblc-conv-ent-to-vla
    	     _kpblc-conv-list-to-3dpoints
    	     prec		      _kpblc-conv-2d-to-3d
    	     )
    
      (defun _kpblc-conv-2d-to-3d (point)
        (list (car point)
    	  (cadr point)
    	  (if (caddr point)
    	    (caddr point)
    	    0.0
    	    ) ;_ end of if
    	  ) ;_ end of list
        ) ;_ end of defun
    
      (defun _kpblc-conv-list-to-2dpoints (lst / res)
        (cond
          ((not lst)
           nil
           )
          (t
           (setq res (cons (list (car lst)
    			     (if (cadr lst)
    			       (cadr lst)
    			       0.
    			       ) ;_ end of if
    			     ) ;_ end of list
    		       (_kpblc-conv-list-to-2dpoints (cddr lst))
    		       ) ;_ end of cons
    	     ) ;_ end of setq
           )
          ) ;_ end of cond
        res
        ) ;_ end of defun
    
      (defun _kpblc-conv-list-to-3dpoints (lst / res)
        (cond
          ((not lst)
           nil
           )
          (t
           (setq res (cons (list (car lst)
    			     (if (cadr lst)
    			       (cadr lst)
    			       0.
    			       ) ;_ end of if
    			     (if (caddr lst)
    			       (caddr lst)
    			       0.
    			       ) ;_ end of if
    			     ) ;_ end of list
    		       (_kpblc-conv-list-to-3dpoints (cdddr lst))
    		       ) ;_ end of cons
    	     ) ;_ end of setq
           )
          ) ;_ end of cond
        res
        ) ;_ end of defun
    
      (defun _kpblc-conv-ent-to-vla	(ent_value)
        (cond
          ((= (type ent_value) 'vla-object) ent_value)
          ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
          ((= (type ent_value) 'list)
           (cond
    	 ((= (type (car ent_value)) 'ename)
    	  (vlax-ename->vla-object (car ent_value))
    	  )
    	 (t
    	  (if
    	    (not
    	      (vl-catch-all-error-p
    		(vl-catch-all-apply
    		  (vlax-ename->vla-object (_kpblc-conv-ent-to-ename ent_value))
    		  ) ;_ end of VL-CATCH-ALL-APPLY
    		) ;_ end of VL-CATCH-ALL-ERROR-P
    	      ) ;_ end of not
    	     nil
    	     ) ;_ end of if
    	  )
    	 ) ;_ end of cond
           )
          (t nil)
          ) ;_ end of cond
        ) ;_ end of defun
    
      (defun _kpblc-conv-ent-to-ename (ent_value)
        (cond
          ((= (type ent_value) 'vla-object) (vlax-vla-object->ename ent_value))
          ((= (type ent_value) 'ename) ent_value)
          ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
          (t nil)
          ) ;_ end of cond
        ) ;_ end of defun
    
      (defun _kpblc-list-dublicates-remove (lst / result)
        (foreach x lst
          (if (not (member x result))
    	(setq result (cons x result))
    	) ;_ end of if
          ) ;_ end of foreach
        (reverse result)
        ) ;_ end of defun
    
      (defun _kpblc-conv-selset-to-ename (selset)
        (if	selset
          (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
          ) ;_ end of if
        ) ;_ end of defun
    
      (defun loc:create-circle (parent center radius layer color / circle)
        (setq circle (vla-addcircle
    		   (vla-objectidtoobject adoc (vla-get-ownerid parent))
    		   (vlax-3d-point center)
    		   radius
    		   ) ;_ end of vla-AddCircle
    	  ) ;_ end of setq
        (vla-put-layer circle layer)
        (vla-put-color circle color)
        ) ;_ end of defun
    
      (vl-load-com)
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      (vla-startundomark adoc)
      (vlax-for item (vla-get-layers adoc)
        (setq lst_layer (append lst_layer (list (vla-get-name item))))
        ) ;_ end of vlax-for
      (if
        (and (setq rt_lay (getstring t "Select the Route layer : "))
    	 (setq thr_lay (getstring t "Select the Trail layer : "))
    	 (setq jn_lay (getstring t "Select the Junction layer : "))
    	 ) ;_ end of and
         (progn
           (if (not (setq prec (getreal "\nSelect a precision <0.0> : ")))
    	 (setq prec 0.0)
    	 ) ;_ end of if
           (foreach	item (mapcar 'vlax-ename->vla-object
    			     (_kpblc-conv-selset-to-ename
    			       (ssget "_X"
    				      (list '(0 . "*POLYLINE")
    					    (cons 8 rt_lay)
    					    ) ;_ end of list
    				      ) ;_ end of ssget
    			       ) ;_ end of _kpblc-conv-selset-to-ename
    			     ) ;_ end of mapcar
    	 (setq lst_vertex
    		(append
    		  lst_vertex
    		  (cond
    		    ((= (vla-get-objectname item) "AcDb3dPolyline")
    		     (_kpblc-conv-list-to-3dpoints
    		       (vlax-safearray->list
    			 (vlax-variant-value (vla-get-coordinates item))
    			 ) ;_ end of vlax-safearray->list
    		       ) ;_ end of _kpblc-conv-list-to-3dpoints
    		     )
    		    (t
    		     (mapcar '_kpblc-conv-2d-to-3d
    			     (_kpblc-conv-list-to-2dpoints
    			       (vlax-safearray->list
    				 (vlax-variant-value (vla-get-coordinates item))
    				 ) ;_ end of vlax-safearray->list
    			       ) ;_ end of _kpblc-conv-list-to-2dpoints
    			     ) ;_ end of mapcar
    		     )
    		    ) ;_ end of cond
    		  ) ;_ end of append
    	       ) ;_ end of setq
    	 ) ;_ end of foreach
           (setq lst_vertex (_kpblc-list-dublicates-remove lst_vertex))
           (foreach	item (mapcar 'vlax-ename->vla-object
    			     (_kpblc-conv-selset-to-ename
    			       (ssget "_X"
    				      (list '(0 . "*POLYLINE")
    					    (cons 8 (strcat thr_lay "," jn_lay))
    					    ) ;_ end of list
    				      ) ;_ end of ssget
    			       ) ;_ end of _kpblc-conv-selset-to-ename
    			     ) ;_ end of mapcar
    	 ;; Now we can create a new circles
    	 ;; in case of quietly points:
    	 (if (member (vlax-curve-getstartpoint item) lst_vertex)
    	   (loc:create-circle item (vlax-curve-getstartpoint item) 0.005 "0" 2)
    	   ) ;_ end of if
    	 (if (member (vlax-curve-getendpoint item) lst_vertex)
    	   (loc:create-circle item (vlax-curve-getendpoint item) 0.005 "0" 2)
    	   ) ;_ end of if
    	 ;|
    	 ;; In case of "equal" function we have to know a precision
    	 (foreach pt (vl-remove-if-not
    		       '(lambda	(x)
    			  (or (equal x (vlax-curve-getstartpoint item) prec)
    			      (equal x (vlax-curve-getendpoint item) prec)
    			      ) ;_ end of or
    			  ) ;_ end of LAMBDA
    		       lst_vertex
    		       ) ;_ end of vl-remove-if-not
    	   (loc:create-circle item pt 1. "0" 3)
    	   ) ;_ end of foreach
    	 |;
    	 ) ;_ end of foreach
           ) ;_ end of progn
         ) ;_ end of if
      (vla-endundomark adoc)
      ) ;_ end of defun
    REMEBER: Your layers should be thawed and unlocked!
    All I say is only my opinion.

  3. #3
    Full Member
    Using
    not specified
    Join Date
    Jul 2006
    Location
    Hyderabad
    Posts
    84

    Default

    hi ,
    thanks for ur great effort. even this coding also taking 3 and 1/2 hours 2 run on 10 MB drawing file. the results r coming exactly.
    can u tell me any other logic.

    regards
    vivek

  4. #4
    Senior Member kpblc's Avatar
    Using
    AutoCAD 2005
    Join Date
    May 2006
    Location
    Russia, St-Petersburg
    Posts
    358

    Default

    Just a moment. I don't understand - this code process more than 3 hours at 1 file? How many polylines over there?
    And (it's just interesting for me) what is the full task? Perhaps you'd better use overkill command (from Express Tools) with or withour flatten.
    About logic... I used this logic: to collect all vertexes of polylines at 1 layer (exclude duplicates); select all polylines at 2nd layer and try to find a start and end points of them in main list (exactly or with some precision); repeat last step with 3rd layer.
    But! this code willn't work correctly with polylines placed not in WCS anŠ² with polylines which get an elevation - to fix this bug need to translate points to wcs. At 99% cases it doesn't requiered, because of this I didn't create this kind of code. But if you really need it, I'll try to do it.
    All I say is only my opinion.

  5. #5
    Full Member
    Using
    not specified
    Join Date
    Jul 2006
    Location
    Hyderabad
    Posts
    84

    Default

    hi
    Actually in the drawing , the 1st layer is having 255980 vertex. the task is same and ur coding gives a exact result. the only problem iam facing is i want 2 reduce the processing time.

    thanks

    regards
    vivek

  6. #6
    Senior Member kpblc's Avatar
    Using
    AutoCAD 2005
    Join Date
    May 2006
    Location
    Russia, St-Petersburg
    Posts
    358

    Default

    Registered forum members do not see this ad.

    Sometimes compiling the code to fas decrease processing time. Try to do it (I never tried this - LT (+ LT Extender) where my lisps are used also doesn't support vlx- and fas-files).
    All I say is only my opinion.

Similar Threads

  1. Checking intersections for gaps (VBA)
    By Joltremari in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 25th Jul 2006, 06:52 am
  2. Polylines to 3D-polylines
    By Tyke in forum AutoCAD Drawing Management & Output
    Replies: 6
    Last Post: 15th Jun 2006, 03:47 pm
  3. polylines
    By david in forum AutoCAD Beginners' Area
    Replies: 2
    Last Post: 31st May 2006, 04:51 am
  4. Checking if project file is loaded or not
    By beproj in forum AutoCAD General
    Replies: 3
    Last Post: 12th Apr 2006, 04:52 am
  5. Polylines
    By Fellucca in forum AutoCAD Beginners' Area
    Replies: 6
    Last Post: 23rd Sep 2004, 04:30 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts