insert block at mid point of a pline

[cblendermann.91943]

I have written a lisp routine to draw a single polyline with user input of width at the beginning of the routine and the users are asking me ti also insert a flow arrow block at the mid point of the drawn pline.
this is the routine:


(DEFUN C:PSAN ()
(SETQ OS (GETVAR "OSMODE"))
(if
(= SIZ nil)
(setq SIZ 0.5)
)
(setq SIZ1 (getreal (strcat "n Enter Pipe size if Different then...<" (rtos SIZ) "> feet..." )))
(if
(= SIZ1 nil)
(setq SIZ SIZ)
(setq SIZ SIZ1)
)
(SETVAR "OSMODE" 6)
(COMMAND "-LAYER" "MAKE" "pr-san-swr" "COLOR" "21" "" "LT" "CONTINUOUS" "" "" )
(setq pt1 (getpoint "nStarting Point: ")
pt2 (getpoint "nEnding Point: ")
)
(COMMAND "PLINE" PT1 "W" siz siz PT2 "")
(COMMAND "CHANGE" "L" "" "P" "LT" "bylayer" "")
(COMMAND "DRAWORDER" "L" "" "B")
(SETVAR "OSMODE" 0)
(princ)
)

I am trying to insert block called "sa1" which is located in my file path, at the mid point of polyline previously defined by pt1 & pt2 and block oriented such that it points in the direction of the end of the polyline.

Due to my lack of LISP knowledge I have unsuccessfully tried to implement the block insertion.

Could someone give me a hint on how to solve this problem?

Any help is greatly appreciated.

Have a great day.

Cord B.

[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]

[Opie]

You may want to have a look at this thread (Distance Lisp Routine Help). I have a lisp routine in there that may help you out.

[Jeff_M]

See if this addition will get you where you want to be....


(setq pt1 (getpoint "\nStarting Point: ")
pt2 (getpoint pt1 "\nEnding Point: ")
midPt (mapcar '/ (mapcar '+ pt1 pt2) '(2.0 2.0 2.0))
rotAng (angle pt1 pt2)
)

[paulmcz]

See if this is what you need.
Just change "block-drawing-path.dwg" to the path on your machine.


(defun c:66 ()
(setq osn (getvar "osmode")
oad (getvar "angdir"))
(setvar "angdir" 0)
(if (= siz nil)
(setq siz 0.5)
)
(setq
siz1 (getreal (strcat "n enter pipe size if different then...<"
(rtos siz)
"> feet..."
)
)
)
(if (= siz1 nil)
(setq siz siz)
(setq siz siz1)
)
(command "-layer" "make" "pr-san-swr" "color"
"21" "" "lt" "continuous"
"" ""
)
(setq pt1 (getpoint "\n starting point: ")
pt2 (getpoint pt1 "\n ending point: ")
u1 (angle pt1 pt2)
u2 (/ (* u1 180) pi)
pt3 (polar pt1 u1 (/ (distance pt1 pt2) 2))
)
(setvar "osmode" 0)
(command "pline" pt1 "w" siz siz pt2 "")
(command "change" "l" "" "p" "lt" "bylayer" "")
(command "._insert" "d:/111/arr.dwg" pt3 "" "" u2)
(command "draworder" "l" "" "b")
(setvar "angdir" oad)
(setvar "osmode" osn)
(princ)
)

[fixo]

If you have many blocks in your block library file you
need to use the following method
See comments inside routine
Change block name "NENT" on your own block name
tested in A2005 only

Thank you

f.



; Convert value in radians to degrees
(defun rtd (a)
(* 180.0 (/ a pi))
)

(DEFUN C:PSAN (/ anb ang aun midpt os pt1 pt2 siz siz1)
(SETQ OS (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(SETQ aun (getvar "aunits"))
(setvar "aunits" 0)
(setq anb (getvar "angbase"))
(setvar "angbase" 0.0)
(setq ang (getvar "angdir"))
(setvar "angdir" 0)
(command "undo" "end")
(command "undo" "be")
(if
(= SIZ nil)
(setq SIZ 0.5)
)
(setq
SIZ1 (getreal (strcat "n Enter Pipe size if Different then...<"
(rtos SIZ)
"> feet..."
)
)
)
(if
(= SIZ1 nil)
(setq SIZ SIZ)
(setq SIZ SIZ1)
)
(setvar "OSMODE" 6)
(if
(not (tblsearch "block" "pr-san-swr"))
(command "-LAYER" "MAKE" "pr-san-swr" "COLOR"
"21" "" "LT" "CONTINUOUS"
"" ""
)
(command "-layer" "T" "pr-san-swr" "U"
"pr-san-swr" "ON" "pr-san-swr" "S"
"pr-san-swr" ""
)
)
(setq pt1 (getpoint "nStarting Point: ")
pt2 (getpoint pt1 "nEnding Point: ")
midpt (mapcar (function (lambda (a b) (/ (+ a b) 2)))
pt1
pt2
)
)
(setvar "OSMODE" 0)
(command "PLINE" PT1 "W" siz siz PT2 "")

(if
(not (tblsearch "block" "NENT"))
(progn
(command "-insert" "~") ; option "~" is allow to choose the block library file from WBrowser
(command);stop file insertion, all of blocks now are already in this drawing
(if (tblsearch "block" "NENT") ;check if this block in this drawing
(command "-insert" "NENT" midpt 1 1 (rtd (angle pt1 pt2)))
(alert "Block \"NENT\" \ndoes not defined in this drawing")
)
)
(command "-insert" "NENT" midpt 1 1 (rtd (angle pt1 pt2)))
)
(command "CHANGE" "L" "" "P" "LT" "bylayer" "")
(command "DRAWORDER" "L" "" "B")
(command "-purge" "B" "*" "N");purge unreferenced blocks if this need,
;(you can comment the string above if not)
(setvar "OSMODE" OS);restore object snap
(setvar "aunits" aun) ;restore angle units
(setvar "angbase" anb);restore angle 0 direction
(setvar "angdir" ang) ;restore CW/CCW angles
(setvar "CMDECHO" 1) ;restore command echo
(command "undo" "end")
(princ)
)
(prompt "\n\t>>>\tType PSAN to execute\t>>>\n")
(princ)

[jwanstaett]

add three line to your lisp and change 5028 to your box name



(DEFUN C:PSAN ()
(SETQ OS (GETVAR "OSMODE"))
(if
(= SIZ nil)
(setq SIZ 0.5)
)
(setq SIZ1 (getreal (strcat "n Enter Pipe size if Different then...<" (rtos SIZ) "> feet..." )))
(if
(= SIZ1 nil)
(setq SIZ SIZ)
(setq SIZ SIZ1)
)
(SETVAR "OSMODE" 6)
(COMMAND "-LAYER" "MAKE" "pr-san-swr" "COLOR" "21" "" "LT" "CONTINUOUS" "" "" )
(setq pt1 (getpoint "nStarting Point: ")
pt2 (getpoint "nEnding Point: ")
)
(COMMAND "PLINE" PT1 "W" siz siz PT2 "")
(COMMAND "CHANGE" "L" "" "P" "LT" "bylayer" "")
(COMMAND "DRAWORDER" "L" "" "B")
(SETVAR "OSMODE" 0)
;;Add lines
(setq an (cal "ang(pt1,pt2)"))
(setq md (cal "(pt1 + pt2)/2"))
(command "insert" "5028" md 1 1 an)
;;end add lines
(princ)
)

[cblendermann.91943]

Thank you for your help,
The cal function shows up as not being defined

The previous lisp proposed give odd results. the block "SA1" is inserted but not lined up with the line. I tried the first and second proposed lisps and got the same result. changing UCS to world did not change the unexpected result either.
Now I got it to work on my machine but other user have the same problem I had when i first tried the revised LISP. I cannot figure out why it now works properly on my machine but not on other peoples machine ????
Any suggestions on settings that might influence the insertion angle for the block?

Thanks

Cord B

[paulmcz]

Thank you for your help,
The cal function shows up as not being defined

The previous lisp proposed give odd results. the block "SA1" is inserted but not lined up with the line. I tried the first and second proposed lisps and got the same result. changing UCS to world did not change the unexpected result either.
Now I got it to work on my machine but other user have the same problem I had when i first tried the revised LISP. I cannot figure out why it now works properly on my machine but not on other peoples machine ????
Any suggestions on settings that might influence the insertion angle for the block?

Thanks

Cord B

If you are talking about the routine I posted, yes, it didn't work properly as I didn't realized at first that "insert" command wouldn't accept rotation angle in radians. I fixed the routine and then edited it in my post after I tested it, this time with various angles of the polyline. It was working fine.
The setting I had, when I was testing was that the UCS was set to 'world' in both inserted block drawing and the drawing I tested the routine in. If you are inserting the block which already exists in the drawing, you should look into rotation and base point of that block and eventually redefine it, or insert the block into the proper position with base point and rotation that exists in the block.
Paul.

[jwanstaett]

The cal function dose not load at startup type cal on the command line will load it and the function will then work.

or add geomcal.arx to your startup
or add (ARXLOAD "GEOMCAL") to your program
Before AutoCAD 2000 geomcal was a lisp program
but I have AUTOLOAD geomcal send AutoCAD DOS 10
I use it in my menu files so I did not think about the function not being load.


Thank you for your help,
The cal function shows up as not being defined


Cord B

[kennet.sjoberg]

I have rewritten your code to fit your needs, note there is no vertex limits,
you may make a block named "Arrow" and located in x direction like this --x-->


(DEFUN C:PSAN (/ OldOsm SIZ SIZ1 pt1 Ent VlaObj MidPoint Param Ang )
(setq OldOsm (GETVAR "OSMODE"))
(if (not SIZ ) (setq SIZ 0.5 ) ( ) )
(setq SIZ1 (getreal (strcat "\n Enter Pipe size if Different then...<" (rtos SIZ ) "> feet..." )) )
(if SIZ1 (setq SIZ SIZ1 ) ( ) )
(SETVAR "OSMODE" 6 )
(COMMAND "-LAYER" "MAKE" "pr-san-swr" "COLOR" "21" "" "LT" "CONTINUOUS" "" "" )
(setq pt1 (getpoint "nStarting Point: " ) )
(COMMAND "PLINE" pt1 "W" siz siz ) ;; The pline can be longer than 2 vertex
(while (= 1 (logand (getvar "CMDACTIVE" ) 1 ) ) (command PAUSE ) ) ;; long as needed
(COMMAND "CHANGE" "L" "" "P" "LT" "bylayer" "" )
(COMMAND "DRAWORDER" "L" "" "B" )

(vl-load-com )
(setq Ent (entlast ) )
(command "_.area" "_o" Ent )
(getvar "PERIMETER")
(setq VlaObj (vlax-ename->vla-object Ent ) )
(setq MidPoint (vlax-curve-getpointatdist VlaObj (/ (getvar "PERIMETER" ) 2 )) )
(setq Param (vlax-curve-getParamAtPoint VlaObj MidPoint ) )
(setq Ang (- (* (/ (Angle (vlax-curve-getFirstDeriv VlaObj Param ) (vlax-curve-getSecondDeriv VlaObj Param ) ) pi ) 180 ) 180 ) )
(command "._insert" "Arrow" MidPoint "" "" Ang ) ;; make a block named Arrow located in x direction like this --x-->
(vlax-release-object VlaObj )

(SETVAR "OSMODE" OldOsm )
(princ)
)


: ) Happy Computing !

kennet

[cblendermann.91943]

Thank you for your inputs but I still can't get any of the routines to insert the arrow block correctly. The arrow inserts correctly only if I draw in the "x" direction with ortho on. in the "y" direction the arrow block is inserted in the opposite direction of pt1-pt2 in any other direction the arrow is inserted with an angle in relation to the polyline....This result is independent of the UCS setting. the ucs in the block is set to "world". odd it is indeed.

Any suggestion? snapang is set to 0 by the way

Cord B.

[paulmcz]

Thank you for your inputs but I still can't get any of the routines to insert the arrow block correctly. The arrow inserts correctly only if I draw in the "x" direction with ortho on. in the "y" direction the arrow block is inserted in the opposite direction of pt1-pt2 in any other direction the arrow is inserted with an angle in relation to the polyline....This result is independent of the UCS setting. the ucs in the block is set to "world". odd it is indeed.

Any suggestion? snapang is set to 0 by the way

Cord B.

Could you post both drawings?

[cblendermann.91943]

Here is a partial of my drawing, the UCS is set to world. ALso attached is the AS1.dwg block. Now I did try the routine in a brand new drawing and the function seemed to work fine. .. My insertion units are set to "unitless" (adjust in attached drawing to recreate the same environment.)
Thanks for the help

Cord B.

[kennet.sjoberg]

You have to do a translation from

Deg/Min/Sec and Clockwise

to

Decimal Degrees and counterclockwise

: ) Happy Computing !

kennet

[paulmcz]

I edited the routine I posted earlier. See if it works now.

[ Moderator Action = ON ] Please excuse the edit, I am only adding a direct link to your earlier post...

RE: insert block at mid point of a pline.

For more information on linking directly to a post, please refer to the following...

Linking directly to a post within a thread (http://forums.augi.com/showthread.php?t=25671) [ Moderator Action = OFF ]

[cblendermann.91943]

Kennet,
My drawing is already set to angles in degrees and runs angles counterclockwise

Paul,
I was still getting errors until I noticed that you had changed the function call name from psan to 66...
so when I updated that part of the command it ran great, other users tested it as well and we have a winner.
Thank you very much for your help and the help from all the other contributors.

Cord B.

[kennet.sjoberg]

Kennet,
My drawing is already set to angles in degrees and runs angles counterclockwise . . .
The file You uploaded is not.
Check attachment 1 = your settings
Check attachment 2 = my suggestions

: ) Happy Computing !

kennet

[cblendermann.91943]

Paul,
YOur routine works now, thank you for your help. I also received a request to insert the flow arrow every 20 feet or at least once is the pipe is shorter than 40 ft +-. An old colleague of mine tweaked the original routine to insert multiple arrows. Here is the LISP for all to use.


(defun c:san (/ osn oad pt1 pt2 Ipt polylen ofdis num angr angd midp)
(setq osn (getvar "osmode")
oad (getvar "angdir")
)
(setvar "angdir" 0)
(if (= siz nil)
(setq siz 0.5)
)
(setq
siz1 (getreal (strcat "n enter pipe size if different then...<"
(rtos siz)
"> feet..."
)
)
)
(if (= siz1 nil)
(setq siz siz)
(setq siz siz1)
)
(command "-layer" "make" "pr-san-swr" "color" "21" "" "lt" "continuous" "" "")
(setq pt1 (getpoint "\n starting point: ")
pt2 (getpoint pt1 "\n ending point: ")
angr (angle pt1 pt2)
angd (/ (* angr 180) pi)
midp (polar pt1 angr (/ (distance pt1 pt2) 2))
polylen (distance pt1 pt2)
ofdis 20
)
(setvar "osmode" 0)
(command "pline" pt1 "w" siz siz pt2 "")
(command "change" "l" "" "p" "lt" "bylayer" "")
(if (>= polylen 41)
(progn
(setq num (fix (/ polylen ofdis))
Ipt (polar pt1 angr ofdis)
)
(repeat num
(command "._insert" "sa1" Ipt 1 1 angd)
(setq Ipt (polar Ipt angr ofdis))
)
)
(command "._insert" "sa1" midp 1 1 angd)
)
(princ)
)Happy computing to you all

Cord B.

[ Moderator Action = ON ]What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]