Jump to content

Crossing Feature Line Lisp routine

broncos15

By broncos15
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Hippe013 Rising Star

Hippe013

Posted
Posted

Bronco15,

 

Below is my revised code. I included (vl-load-com) this time. I don't usually worry about (vl-load-com) because it is called in other start-up lisps. I suppose it is good practice to always include this as it doesn't hurt if it is called more than once. (Just don't put it in a loop of course!)

 

What is different in this code is I get all the points of the selected feature line through the GETPOINTS method. This requires an integer argument. I believe it is 1 for PI Points 2 for Elevation Points and 3 for all points. I want to test against all points so I use 3. I also grab all points from the feature line that I am testing against. GETPOINTS returns a variant so I need to convert this to a safearray and then to a list using both vlax-variant-value and then vlax-safearray->list.

 

So the logic is as follows:

 

I get a list of possible intersections. (This list may contain duplicates.) For each point in the intersections list (symbol catch) test to see if I've already processed this point (symbol proc). I don't want to process duplicate points. Next make sure the point is not a member of my selected feature line points (symbol fl-pnts). If its not a member Insert Feature Point and increment p-count. Next make sure the point is not a member of my testing feature line points (symbol f-pnts). If it isn't then Insert Feature Point and increment p-count.

 

(vl-load-com)

(defun c:FLINT ( / fl site fls p-count sa catch n proc)
 (setq ss (ssget "_+.:E:S" '((0 . "AECC_FEATURE_LINE"))))
 (if ss
   (progn
     (setq fl (vlax-ename->vla-object (ssname ss 0)))
     [color="red"](setq fl-pnts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method fl 'GetPoints 3))))[/color]
     [color="red"](setq fl-pnts (FL:list->pntlist fl-pnts))[/color]
     (setq site (FL:FL->site fl))
     (setq fls (vlax-get-property site 'Featurelines))
     (setq p-count 0)
     (vlax-for f fls
(if (not (equal f fl))
  (progn
    
    (setq sa (vlax-variant-value (vlax-invoke-method fl 'IntersectWith f acExtendNone)))
    (setq catch (vl-catch-all-apply 'vlax-safearray->list (list sa)))
    (if (not (vl-catch-all-error-p catch))
      (progn
	(setq catch (fl:list->pntlist catch))
	(setq n 0)
	[color="red"](setq f-pnts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method f 'GetPoints 3))))[/color]
	[color="red"](setq f-pnts (FL:list->pntlist f-pnts))[/color]
	(repeat (length catch)
	  (setq p (nth n catch))
	  (if (not (member p proc))
	    (progn
	      ;Use 2 for Elevation Point - Use 1 for PI
	      (if[color="red"] (not (member p fl-pnts))[/color]
		(progn
		  (vlax-invoke-method fl 'InsertFeaturePoint (vlax-3d-point p) 2)
		  (fl:drx p 2)
		  (setq proc (append proc (list p)))
		  (setq p-count (+ p-count 1))))
	      
	      (if [color="red"](not (member p f-pnts))[/color]
		(progn
		  (vlax-invoke-method f 'InsertFeaturePoint (vlax-3d-point p) 2)
		  (fl:drx p 2)
		  (setq proc (append proc (list p)))
		  (setq p-count (+ p-count 1))))
	      )
	    )
	  (setq n (+ n 1))
	  )
	)
      (progn)
      )
    )
  )
)
     (princ (strcat "\nInserted " (itoa p-count) " Elevation Points."))
     )
   (princ "\nNothing was Selected.")
   )
 (princ)
 )


(defun FL:Site->FL-ID-List (site / fls cnt ret n li)
 (setq fls (vlax-get-property site 'Featurelines))
 (setq cnt (vlax-get-property fls 'Count))
 (if (= cnt 0)
   (setq ret nil)
   (progn
     (setq n 0)
     (repeat cnt
(setq li (append li (list (vlax-get-property (vla-item fls n) 'ObjectID))))
(setq n (1+ n))
)
     (setq ret li)
     )
   )
 ret
 )

(defun FL:List->pntlist (li / newli n)
 (setq n 0)
 (repeat (/ (length li) 3)
   (setq newli (append newli (list (list (nth n li)
			    (nth (+ n 1) li)
			    (nth (+ n 2) li)))))
   (setq n  (+ n 3))
   )
 newli)

(defun FL:FL->Site (fl / cvlapp cvlad sites ret n site objid-list )
 (setq cvlapp (vlax-get-property fl 'application))
 (setq cvlad (vlax-get-property cvlapp 'ActiveDocument))
 (setq sites (vlax-get-property cvlad 'Sites))
 (setq ret nil)
 (setq n 0)
 (repeat (vlax-get-property sites 'Count)
   (setq site (vla-item sites n))
   (setq objid-list (FL:Site->FL-ID-List site))
   (if (member (vlax-get-property fl 'ObjectID) objid-list)
     (setq ret site)
     )
   (setq n (1+ n))
   )
 ret
 )


(defun FL:drx (ctr clr / cor1 cor2 cor3 cor4 vs xs)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 40))
 (setq cor1 (polar ctr (* pi 0.25) xs))
 (setq cor2 (polar ctr (* pi 0.75) xs))
 (setq cor3 (polar ctr (* pi 1.25) xs))
 (setq cor4 (polar ctr (* pi 1.75) xs))
 (grdraw ctr cor1 clr 0)
 (grdraw ctr cor2 clr 0)
 (grdraw ctr cor3 clr 0)
 (grdraw ctr cor4 clr 0)
 )

 

Give this a try and see if it works as expected.

 

regards,

 

hippe013

Link to comment
Share on other sites
  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • broncos15

    11

  • Hippe013

    7

  • BlackBox

    4

  • robert06

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Hippe013
Hippe013

This is what I came up with. I call the command 'FLINT' for feature line intersection. Prompts user to select a featureline. It then finds what site it belongs to and all other featurelines that belon

broncos15 Proficient

broncos15

Posted
  • Author
Posted
Bronco15,

 

Below is my revised code. I included (vl-load-com) this time. I don't usually worry about (vl-load-com) because it is called in other start-up lisps. I suppose it is good practice to always include this as it doesn't hurt if it is called more than once. (Just don't put it in a loop of course!)

 

What is different in this code is I get all the points of the selected feature line through the GETPOINTS method. This requires an integer argument. I believe it is 1 for PI Points 2 for Elevation Points and 3 for all points. I want to test against all points so I use 3. I also grab all points from the feature line that I am testing against. GETPOINTS returns a variant so I need to convert this to a safearray and then to a list using both vlax-variant-value and then vlax-safearray->list.

 

So the logic is as follows:

 

I get a list of possible intersections. (This list may contain duplicates.) For each point in the intersections list (symbol catch) test to see if I've already processed this point (symbol proc). I don't want to process duplicate points. Next make sure the point is not a member of my selected feature line points (symbol fl-pnts). If its not a member Insert Feature Point and increment p-count. Next make sure the point is not a member of my testing feature line points (symbol f-pnts). If it isn't then Insert Feature Point and increment p-count.

 

(vl-load-com)

(defun c:FLINT ( / fl site fls p-count sa catch n proc)
 (setq ss (ssget "_+.:E:S" '((0 . "AECC_FEATURE_LINE"))))
 (if ss
   (progn
     (setq fl (vlax-ename->vla-object (ssname ss 0)))
     [color=red](setq fl-pnts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method fl 'GetPoints 3))))[/color]
     [color=red](setq fl-pnts (FL:list->pntlist fl-pnts))[/color]
     (setq site (FL:FL->site fl))
     (setq fls (vlax-get-property site 'Featurelines))
     (setq p-count 0)
     (vlax-for f fls
   (if (not (equal f fl))
     (progn
       
       (setq sa (vlax-variant-value (vlax-invoke-method fl 'IntersectWith f acExtendNone)))
       (setq catch (vl-catch-all-apply 'vlax-safearray->list (list sa)))
       (if (not (vl-catch-all-error-p catch))
         (progn
       (setq catch (fl:list->pntlist catch))
       (setq n 0)
       [color=red](setq f-pnts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method f 'GetPoints 3))))[/color]
       [color=red](setq f-pnts (FL:list->pntlist f-pnts))[/color]
       (repeat (length catch)
         (setq p (nth n catch))
         (if (not (member p proc))
           (progn
             ;Use 2 for Elevation Point - Use 1 for PI
             (if[color=red] (not (member p fl-pnts))[/color]
           (progn
             (vlax-invoke-method fl 'InsertFeaturePoint (vlax-3d-point p) 2)
             (fl:drx p 2)
             (setq proc (append proc (list p)))
             (setq p-count (+ p-count 1))))
             
             (if [color=red](not (member p f-pnts))[/color]
           (progn
             (vlax-invoke-method f 'InsertFeaturePoint (vlax-3d-point p) 2)
             (fl:drx p 2)
             (setq proc (append proc (list p)))
             (setq p-count (+ p-count 1))))
             )
           )
         (setq n (+ n 1))
         )
       )
         (progn)
         )
       )
     )
   )
     (princ (strcat "\nInserted " (itoa p-count) " Elevation Points."))
     )
   (princ "\nNothing was Selected.")
   )
 (princ)
 )


(defun FL:Site->FL-ID-List (site / fls cnt ret n li)
 (setq fls (vlax-get-property site 'Featurelines))
 (setq cnt (vlax-get-property fls 'Count))
 (if (= cnt 0)
   (setq ret nil)
   (progn
     (setq n 0)
     (repeat cnt
   (setq li (append li (list (vlax-get-property (vla-item fls n) 'ObjectID))))
   (setq n (1+ n))
   )
     (setq ret li)
     )
   )
 ret
 )

(defun FL:List->pntlist (li / newli n)
 (setq n 0)
 (repeat (/ (length li) 3)
   (setq newli (append newli (list (list (nth n li)
                   (nth (+ n 1) li)
                   (nth (+ n 2) li)))))
   (setq n  (+ n 3))
   )
 newli)

(defun FL:FL->Site (fl / cvlapp cvlad sites ret n site objid-list )
 (setq cvlapp (vlax-get-property fl 'application))
 (setq cvlad (vlax-get-property cvlapp 'ActiveDocument))
 (setq sites (vlax-get-property cvlad 'Sites))
 (setq ret nil)
 (setq n 0)
 (repeat (vlax-get-property sites 'Count)
   (setq site (vla-item sites n))
   (setq objid-list (FL:Site->FL-ID-List site))
   (if (member (vlax-get-property fl 'ObjectID) objid-list)
     (setq ret site)
     )
   (setq n (1+ n))
   )
 ret
 )


(defun FL:drx (ctr clr / cor1 cor2 cor3 cor4 vs xs)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 40))
 (setq cor1 (polar ctr (* pi 0.25) xs))
 (setq cor2 (polar ctr (* pi 0.75) xs))
 (setq cor3 (polar ctr (* pi 1.25) xs))
 (setq cor4 (polar ctr (* pi 1.75) xs))
 (grdraw ctr cor1 clr 0)
 (grdraw ctr cor2 clr 0)
 (grdraw ctr cor3 clr 0)
 (grdraw ctr cor4 clr 0)
 )

Give this a try and see if it works as expected.

 

regards,

 

hippe013

This code is awesome. I tested it out and it seems to work perfectly. I want to make sure that I understand it correctly: 
[color=black](setq f-pnts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method f 'GetPoints 3))))[/color]
[font=Segoe UI][size=2]

[font=Segoe UI][size=2]

This is making a list of all the different 3d points (both elevation points and PI's). You then have the code test in the if statement whether the point is in your list, and if not, then you insert an elevation point. Thank you so much for making and sharing this! I know it will save me a lot of time grading.

[/size][/font][/size][/font]

Link to comment
Share on other sites
  • 1 year later...
robert06 Rookie

robert06

Posted
Posted

Hi,

It's a useful lisp! What should be changed, if I wanted PI's not elevation points inserted.

 

Thank you

 

Robert

Link to comment
Share on other sites
Hippe013 Rising Star

Hippe013

Posted
Posted

I'm glad you find this Lisp useful.

 

Look for the method 'InsertFeaturePoint, change the 2 to a 1. That should do the trick.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...