Jump to content

Calling all LISP Brainiacs


onthespot

Recommended Posts

Ive resigned myself to the fact that it will take me 10 times as long to figure it out and can probably accomplish a lot more sticking to the things I do best and leaving the LISP to those with the "gift" to create them.

 

I'm in need of a lisp routine that would allow me to select a line and then allow me to copy or "array" a circle of a certain diameter along the line.

 

As an example lets say I have a line 3 inches long. I'd like to be able to specify the diamter of a circle (through a dialog box if possible) and when I place it one of the ends of a line, the circle then repeats itself at a predertermined spacing (entered by user) throughout the line. If there are multiple lines that have been joined and converted to a polyline I'd like the routine to work as well through out the lines.

 

Can anyone help or perhaps point me in the right direction if this has already been done and posted? Thank You.

Link to comment
Share on other sites

Sounds like the MEASURE command can accomplish this if your circle is a block it will insert it at your specified spacing.

Link to comment
Share on other sites

Here is the code:

 

(defun c:xdiv(/ *error* cCurve curPt dPar dPt
      enPt fPar fPt maxLen obType oldDis
      oldOsn posDir rClose sFlag stPt
      sumDis swMod undoLst vClose whatDo)

 (vl-load-com)

 (defun asmi_GetActiveSpace(/ actDoc)
   (if
     (= 1(vla-get-ActiveSpace
    (setq actDoc
	   (vla-get-ActiveDocument
      (vlax-get-acad-object)
      ); end vla-get ActiveSpace
     ); end setq
    ); end vla-get-ActiveDocument
 ); end =
     (vla-get-ModelSpace actDoc)
     (vla-get-PaperSpace actDoc)
     ); end if
   ); end of asmi_GetActiveSpace

 (defun RestorePointStyle()
   (if
     (and xdiv:oldPm xdiv:oldPs)
     (progn
(initget "Yes No")
(setq swMod
     (getkword
       "\nRestore point style? [Yes/No] <No>: "))
(if(null swMod)(setq swMod "No"))
(if
 (= swMod "Yes")
  (progn
    (princ "\nPlease wait... \n")
    (setvar "PDMODE" xdiv:oldPm)
    (setvar "PDSIZE" xdiv:oldPs)
  ); end progn
 ); end if
); end progn
     ); end if
(princ)
     ); end of RestorePointStyle

 (defun AddPointOrInsert(Mode Block Scale)
   (vla-AddPoint
	(asmi_GetActiveSpace)
		    (vlax-3d-point curPt))
   ); end of AddPointOrInsert

 (defun AddPointOrInsert(Mode Block Scale / outObj)
   (setq undoLst
    (append
     (list
(list
 (setq outObj
   (vla-AddPoint
	(asmi_GetActiveSpace)
		    (vlax-3d-point curPt))); end setq
  curPt xdiv:curDis
); end list
      ); end list
        undoLst); end append
 ); end setq
   outObj
   ); end of AddPointOrInsert

 (defun *error*(msg)
   (if cCurve
     (progn
 (vla-Highlight cCurve :vlax-false)
   (setvar "OSMODE" oldOsn)
  ); end progn
); end if
    (princ "\n*Cancel*")
   (princ)
   ); end of *error*	 
 (if
   (member
     (setq xdiv:oldPm(getvar "PDMODE"))
     '(0 1)
     ); end member
   (progn
     (setq xdiv:oldPs(getvar "PDSIZE"))
     (initget "Yes No")
     (setq swMod
     (getkword
       "\nChange points style to good visible? [Yes/No] <Yes>: "))
     (if(null swMod)(setq swMod "Yes"))
     (if
(= swMod "Yes")
 (progn
   (princ "\nPlease wait... \n")
   (setvar "PDMODE" 35)
   (setvar "PDSIZE" -2)
  ); end progn
); end if
     ); end progn
   ); end if
 (setq oldOsn
 (getvar "OSMODE")); end setq
 (if
   (not xdiv:curDis)
     (setq xdiv:curDis 1.0
    xdiv:oldDis 1.0); end setq
     ); end if
 (if
    (setq cCurve
   (entsel
       "\nSelect curve > ")); end setq
   (progn
     (setq cCurve
     (vlax-ename->vla-object
       (car cCurve))); end setq
     (if
(member
  (setq obType
	 (vla-get-ObjectName cCurve))
  '("AcDbLine" "AcDbPolyline" "AcDb3dPolyline"
    "AcDbSpline" "AcDbArc" "AcDbCircle" "AcDbEllipse")
  ); end member
(progn
  (vla-Highlight cCurve :vlax-true)
  (setvar "OSMODE" 3071)
  (setq stPt
	(vlax-curve-GetStartPoint cCurve)
	enPt
	(vlax-curve-GetEndPoint cCurve)
	fPt
	 (getpoint
	   "\nPick start markup point at curve > ")
	); end setq
  (if fPt
     (setq fPt(trans fPt 1 0)
           curPt(vla-AddPoint
		  (asmi_GetActiveSpace)
		    (vlax-3d-point fpt)); end vla-AddPoint
	   undoLst
	    (list
	      (list curPt 0.0 0.0)); end list
	   ); end setq
    ); end if
  (if
    (and
      fPt
      (setq fPar
	     (vlax-curve-GetParamAtPoint cCurve fPt))
      ); end and
    (progn
      (if
	(and
	  (not(equal fPt stPt 0.0001))
	  (not(equal fPt enPt 0.0001))
	  ); end or
	(progn
	  (setq dPt
		 (getpoint fPt
		   "\nPick point at curve to specify markup direction > "))
	  (if dPt
            (setq dPt(trans dPt 1 0))); end if
	  (if
	    (and
	      dPt
	      (setq dPar
		     (vlax-curve-GetParamAtPoint cCurve dPt))
	     ); end and
	    (progn
	      ); end progn
	      (princ "\nEmpty input or point not at curve! ")
	    ); end if
	  ); end progn
	); end if
      ); end progn
    (princ "\nEmpty input or point not at curve! ")
    ); end if
  ); end progn
(princ "\nInvalid object type! ")
); end if
     (setq maxLen
     (-
       (vlax-curve-GetDistAtPoint cCurve enPt)
       (vlax-curve-GetDistAtPoint cCurve stPt)
       ); end -
    rClose
     (vlax-curve-IsClosed cCurve)
    ); end setq
     (if(equal fPt stPt 0.0001)
(setq vClose T)
); end if
     (if
(or
  (equal fPt stPt 0.0001)
  (and
    dPar
    (> dPar fPar)
    ); end and
  ); end or
(setq posDir T
      sumDis
	 (vlax-curve-GetDistAtPoint cCurve fPt)
      ); end setq
(setq sumDis
       (- maxLen
	(- maxLen
	 (vlax-curve-GetDistAtPoint cCurve fPt)))
      ); end setq
); end if
     	      (while(not sFlag)
	(setq whatDo
	       (getstring
		 (strcat
		 "\nSpecify distance or [undo/Quit] <"
		 (if xdiv:curDis(rtos xdiv:curDis) "not defined")
		   ">: "); end strcat
		 ); end getstring
	      ); end setq
	(cond
	  ((or
	     (= 'REAL(type(distof whatDo)))
	     (= "" whatDo)
	     ); end or
	   (if(= "" whatDo)
	     (setq xdiv:curDis xdiv:oldDis)
	     (setq xdiv:curDis(distof whatDo))
	     ); end if
	   (setq xdiv:oldDis xdiv:curDis); end setq
	   	(cond
		  (posDir
		     (setq sumDis
			    (+ sumDis xdiv:curDis)
			   curPt
			    (vlax-curve-GetPointAtDist cCurve sumDis)
			   ); end setq
		     (if curPt
		       (AddPointOrInsert nil nil nil)
		       (princ "\n>>> End of line <<< ")
		          ); end if
		     ); end condition # 1
		  ((not posDir)
		     (setq sumDis
			    (- sumDis xdiv:curDis)
			   curPt
			    (vlax-curve-GetPointAtDist cCurve sumDis)
			   ); end setq
		     (if curPt
		       (AddPointOrInsert nil nil nil)
		       (princ "\n>>> End of line <<< ")
		          ); end if
		     ); end condition # 1
		  ); end cond
	   ); end condition #1
	  ((=(strcase whatDo) "Q")
	   (if
	     (= 1(length undoLst))
	      (vla-Delete(caar undoLst))
	     ); end if
	   (RestorePointStyle)
	   (if cCurve
            (progn
             (vla-Highlight cCurve :vlax-false)
              (setvar "OSMODE" oldOsn)
            ); end progn
           ); end if
	   (setq sFlag T)
	   )
	  ((=(strcase whatDo) "U")
	   (if
	     (and
	       undoLst
	       (/= 1(length undoLst))
	       ); end and
	     (progn
	      (vla-Delete(caar undoLst))
	      (setq undoLst(cdr undoLst)
		    curPt(cadar undoLst)
		    sumDis(- sumDis
			     (last
			       (car undoLst)))
		    ); end setq
	      ); end progn
	     (princ "\n>>> Nothing to undo <<< ")
	     ); end if
	   )
	  ); end cond
	); end while
     ); end progn
   (princ "\nEmpty selection! ")
   ); end if
 (princ)
 ); end of c:xdiv

Link to comment
Share on other sites

WOW...you guys are great! The measure command does work however it doesnt automatically recognize a change of direction on a multi line segment. I need a circle by default to be located at each corner.

 

The xdiv routine works great as well along the path.

Link to comment
Share on other sites

Thanks ASMI, but can you please able add an optional command to have ID text or (auto)number beside each point.

 

It possible, but I very busy now. May be next week. May be Lee Mac want to dig this code.

Link to comment
Share on other sites

It possible, but I very busy now. May be next week. May be Lee Mac want to dig this code.

 

ASMI, I would love to - but this coding is much too advanced for the likes of me :( :oops:

Link to comment
Share on other sites

  • 9 years later...
On 2/4/2009 at 1:17 AM, ASMI said:

Something like this, but with circle?

Xdiv.gif

 

Edited by Deepak.kv
Amsi can you pls tell me how I am insert this lsp and what is the command of this lsp pls rply me it's very important
Link to comment
Share on other sites

Here's a simple LISP program that does something similar to what I think you want.  It uses the arraypath command.  To try it out create a spline and place a circle with its center at the beginning of the spline. The first time you give the command xalong and y to the prompt "Is this the first copy?"  after that answer no ( the default) and the distance specified will be from the last copy of the circle. 

 

(defun c:xalong (/)
  (setq s (getreal "\nEnter distance: "))
  (initget "Yes No")
  (if
    (=
      (getkword
	"Is this the first copy? [Yes/No] <N>: "
      )
      "Yes"
    )					;end =
     (progn
       (setq d s)
       (princ "\n Select Object(s) to be copied then hit Enter")
       (setq e (ssget))
       (setq eno (ssname e 0))
       (setq edo (entget en))
       (princ "\nSelect the Path ")
       (setq e (ssget))
       (setq enp (ssname e 0))
       (setq edp (entget en))
     )					;end true
     (setq d (+ d s))			; 'false'
  )					; end if
  (command "arraypath" eno "" enp 2 d "x")
)

 

Link to comment
Share on other sites

  • 2 years later...
On 2/4/2009 at 1:17 AM, ASMI said:

Something like this, but with circle?

Xdiv.gif

Hello everyone,

 

I need same lisp to draw point on curve line.

But in my case, I have already point at mid or anywhere on line, and I want draw point from mid , backward and forward at desire length.

Not from start,

Point already is there at mid or any location,

From that I want draw point at desire length,

Both or one side.

Thanks

Link to comment
Share on other sites

You need to start having a go. Your reputation is getting worse.

 

1st step is work out pline direction compared to point, then

vlax-curve-getDistAtPoint obj pt)

use getpointatdist obj dist for new pts.

Link to comment
Share on other sites

On 6/2/2021 at 8:33 PM, Ish said:

Hello everyone,

 

I need same lisp to draw point on curve line.

But in my case, I have already point at mid or anywhere on line, and I want draw point from mid , backward and forward at desire length.

Not from start,

Point already is there at mid or any location,

From that I want draw point at desire length,

Both or one side.

Thanks

 

If you want to go backwards, just input a negative value.

And besides, in that program, you can pick the start anywhere you want.

  • Like 1
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...