Jump to content

Lisp help please


CFORD

Recommended Posts

(defun c:APV (/ ss1 Lastent TargEnt TargLayer undo obj ss of en pt ent) 
 		(setq SS1 (ssadd))
 		(setq LastEnt (entlast))
		(while (setq TargEnt (car (entsel "\nSelect object on layer to select: "))) 
  		(setq TargLayer (assoc 8 (entget TargEnt)))
  		(sssetfirst nil (ssget "_X" (list TargLayer)))
   		(defun *error* (msg)
   		(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      		(princ (strcat "\n** Error: " msg " **")))
   		(princ)
  		)

	(if (and (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))
          (setq of (getdist "\nSpecify Offset Distance: ")))
   (progn
     (setq undo
       (not
         (vla-StartUndomark
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
     )  
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
           (lambda ( o )
             (vl-catch-all-apply
               (function vla-offset) (list obj o)
             )
           )
         )
         (list of (- of))
       )
     )
     (vla-delete ss)
	(setq undo (vla-EndUndoMark doc))
   )
 )
)
(if (setq en (entnext LastEnt))  ;adds all offsets to SS1
      (while en
        (ssadd en SS1)
        (setq en (entnext en))))

 (while (setq pt (getpoint "\nPick internal point: "))
   (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
) 
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS1)))
    (entdel ent) 
)                
(princ)
)

Hello I need some help please. I have put together this code here. the working principles of this is to do the following 

Select all objects layer

Offset distance = 

Select all objects  layer

Offset distance = 

Offsets are done in and out of every layer that is selected at the required offset distance.

Boundary command is done to work out the internal boundary of area selected

Continue onto the next boundary to select

when exiting the command the offsets that were produced are deleted the only thing to remain is the boundary lines

 

But there is a bit of a problem with this command as shown below 

image.png.ff1c1cb6c41b09c1430015a234f6ac60.png

image.png.422ea02897a714ada4ec4c5904e92665.png

image.png.aeddb42ca7122ce3ad3cc31f1f3c6bc8.png

as you can see the boundary that was created in pink did not consider the white polyline in this boundary. So I thought then the polylines that are offset should be a closed shape but I dont know how to do that in lisp so if anyone knows how to do this that would be great.

I found this 

https://cadtips.cadalyst.com/linear-objects/draw-a-cap-or-pipe-end?q=linear-objects/draw-a-cap-or-pi...

which I used and it is really good but it needs to close these objects automatically without me selecting anything.

I appreciate any help that can be given I appreciate it might not be possible.  

Cheers

Link to comment
Share on other sites

This might need a little reworking on the offset part to create a closed polyline object - which should be OK after that?

 

It should be possible, I think in one of your previous questions I offered a (longer and slower) solution that had a while loop - might be that this can be modified to create a closed polyline from an offset line or whatever using the end points of the new offsets, then join them together.

 

I'll have a think later to see if I can make something up that works there

Link to comment
Share on other sites

Yes that might work thank you for replying and being so active on this!! I have another solution that might be a possible solution as well. 

It involves adding a small circle to the end of every polyline/line (0.01m or so). Then when the offset is done it is joined. that circle can then be deleted with the rest of the offsets at the end.

 

Using imagery this is what I mean 

image.thumb.png.5874aa9eea5cd5b9c7c50b9aa630ee17.png

image.png.2d5224126f8167935e2488815de680c0.pngimage.thumb.png.54f95cc4a5ac75c16ae2cc764d3dd802.png

And then you get the boundary like so

 

Does that make things easier? @Steven P

Link to comment
Share on other sites

I see what you are meaning, my thoughts on this are that drawing a line between end points is just as easy (in the offsets, both start ends are next to each other, both end points are the same, so can use (vlax-curve-getStartPoint Obj) and (vlax-curve-getEndPoint OffObj) for these.... should work

Link to comment
Share on other sites

Try this 

 

(defun c:APV (/ ss1 Lastent TargEnt TargLayer undo obj ss of en pt ent) 
  (defun OffsetJoin ( MyEnt of / acount pt1 pt2 pt3 pt4 MyLines MyOffset)
  (setq MyLines (ssadd))
    (setq VlaOb (vlax-ename->vla-object MyEnt))
    (setq entype (cdr (assoc 0 (cdr (entget MyEnt)))))
    (vla-offset VlaOb of ) ;; offset line 1

    (setq OffObj (vlax-ename->vla-object (entlast)))
    (setq MyLines (ssadd (entlast) MyLines)) ;; add offset to selection set
    (setq pt1 (vlax-curve-getStartPoint OffObj) )
    (setq pt2 (vlax-curve-getEndPoint OffObj) )

    (vla-offset VlaOb (* of -1) ) ;; offset line 2
    (setq MyLines (ssadd (entlast) MyLines)) ;; add offset to selection set
    (setq OffObj (vlax-ename->vla-object (entlast)))
    (setq pt3 (vlax-curve-getStartPoint OffObj) )
    (setq pt4 (vlax-curve-getEndPoint OffObj) )

    (if (or 
          (= (cdr (assoc 0 (cdr (entget MyEnt)))) "CIRCLE") ; Circle
          (= (cdr (assoc 0 (cdr (entget MyEnt)))) "ELLIPSE") ; Ellipse
          (= (cdr (assoc 70 (cdr (entget MyEnt)))) 1) ; closed polyline
        )
      (progn ;Circles, Closed polylines
      ) ; end progn
      (progn ; open entities
        (command "line" pt1 pt3 "")
        (setq MyLines (ssadd (entlast) MyLines)) ;; add offset to selection set
        (command "line" pt2 pt4 "")
        (setq MyLines (ssadd (entlast) MyLines)) ;; add offset to selection set
        (command "pedit" "m" (ssname MyLines 0) (ssname MyLines 2) (ssname MyLines 3) (ssname MyLines 1) "" "Y" "J" "" "")
      ) ; end progn
    ) ; end if
  ) ; end defun offsetjoin




        (setq SS1 (ssadd))
 		(setq LastEnt (entlast))
		(while (setq TargEnt (car (entsel "\nSelect object on layer to select: "))) 
  		  (setq TargLayer (assoc 8 (entget TargEnt)))
  		  (sssetfirst nil (ssget "_X" (list TargLayer)))
   		  (defun *error* (msg)
   		    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      		      (princ (strcat "\n** Error: " msg " **"))
		    ) ; endor
   		    (princ)
  		) ; end defun

  (if (and (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))))
           (setq of (getdist "\nSpecify Offset Distance: "))
      ) ;; end and
    (progn
      (setq undo (not
        (vla-StartUndomark
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object) ))
        )
      )) ; end not, end setq

;;New Part
      (setq acount 0)
      (while (< acount (sslength ss))
        (offsetjoin (ssname ss acount) of)
        (setq acount (+ acount 1)) 
      ) ; end while
;; End New Part 

;;     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
;;       (mapcar
;;         (function
;;           (lambda ( o )
;;             (vl-catch-all-apply
;;               (function vla-offset) (list obj o)
;;             )
;;           )
;;         )
;;         (list of (- of))
;;       )
;;     )
;     (vla-delete ss)
	(setq undo (vla-EndUndoMark doc))
      ) ; end progn
    ) ; end if
  ) ; end while
  (if (setq en (entnext LastEnt))  ;adds all offsets to SS1
      (while en
        (ssadd en SS1)
        (setq en (entnext en))
      ) ; end while
  ) ; end if

  (while (setq pt (getpoint "\nPick internal point: "))
    (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
  ) ; end while 
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS1)))
    (entdel ent) 
  ) ; end foreach

  (princ)
)

 

Link to comment
Share on other sites

Just a couple of comments, when you select the white line for offset which end is start ? So the end lines may get drawn on the wrong end. I use a check distance from end points to pick point and then can see whether to join start or ends of new offset.

 

I use this for -ve (- of) note space between - and of. 

 

An example of check end. once you know start or end then offset matches.

(defun doline ( / d1 d2)
(setq pt1 (vlax-get Obj 'StartPoint))
(setq pt2 (vlax-get Obj 'EndPoint))
(setq d1 (distance pt1 pt3)
	    d2 (distance pt2 pt3)
)
(if (< d1 d2)
    (progn
    (setq temp pt1)
    (setq pt1 pt2)
    (setq pt2 temp)
    )
)
(princ)
)

(setq ent (entsel "\npick p/line near end "))
(setq pt3 (cadr ent))
(setq obj (vlax-ename->vla-object (car ent))) 
(doline )

 

  • Like 1
Link to comment
Share on other sites

Hi @Steven P Thank you for getting on this. I tried it out and it worked very well at closing the lines and doing the offsets. There was one problem that I was finding that it wasn't moving onto the boundary command afterwards. Thank you very much for your help It is very useful to see how this code is written learning a lot.

Link to comment
Share on other sites

55 minutes ago, CFORD said:

Hi @Steven P Thank you for getting on this. I tried it out and it worked very well at closing the lines and doing the offsets. There was one problem that I was finding that it wasn't moving onto the boundary command afterwards. Thank you very much for your help It is very useful to see how this code is written learning a lot.

 

Can you post a sample drawing of what you tried - it worked for me just now

Link to comment
Share on other sites

On 11/25/2022 at 11:30 PM, BIGAL said:

Just a couple of comments, when you select the white line for offset which end is start ? So the end lines may get drawn on the wrong end. I use a check distance from end points to pick point and then can see whether to join start or ends of new offset.

 

 

Yup, good point, in this example though the line is offset both directions and these offset lines will have start end and end end at the same end (?!)

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.

×
×
  • Create New...