Topic: 2d pipe lisp

[eric]

Well put Keith.  Thanks for the chuckle

[Bob Wahr]

If I was going to guess, based on some of the random crap in the file, that said cad manager has little if any programming knowledge or ability (duh) but found a programon the internet somewhere that does what he wants.  But up pops a problem, it's compiled and he wants to take credit for writing it.  back to google, find a decompiler, change the name, claim it.  I have no idea what decompiled lisp looks like but for those who do, is it like this?

[CAB]

Here is a start for your routine.

There are many ways for this routine to fail as there is no error checking.
There are may areas of this routine that need improvement, but that is for
you or someone else to do.

You will want to look at the following for improvements:
Placing the new objects on there proper layer.
Changing the center line linetype.
Setting the correct text style & height.
Creating an offset for the text above the line.
Correcting the text angle so the text will be on top or left of the segment

Perhaps fillet the pipe turns.

What appears a trivial task may fool you.
But if you break the routine into sub tasks it is a lot easer.
Solving each sub task is not too difficult.

Good Luck with your project.
CAB

Code: [Select]

;;  pick center line path for pipe, current layer for now
;;  enter pipe width
;;  Draw pipe with center line
;;  Attach label to pipe center line using current text


(defun c:pipedraw (/ usrcmd usros usrplw oldent ent pipecl pipe1 pipe2 txtpt
                   L_Angle txt ang par width
                  )
  (vl-load-com)
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  save & set some system variables
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (setq usrcmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq usros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq usrplw (getvar "plinewid"))
  (setvar "plinewid" 0)

  (prompt "\nPipe Draw Routine.")

  (setq oldent (entlast))
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  Let the user draw a pline,any number of segments
  ;;   repeat a point input until Enter
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (prompt "\nPick points for pipe center line.")
  (command "._PLINE")
  (while (> (getvar "CMDACTIVE") 0)
    (command pause)
  )

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  make sure a pline was drawn 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (if (eq (setq ent (entlast)) oldent)
    (quit)
  )


  ;;+-+-+-+-+-+-+-+-+-+-+-+
  ;;  Get the pipe width   
  ;;+-+-+-+-+-+-+-+-+-+-+-+
  (initget (+ 1 2 4)) ; no nul, zero, or negative
  (setq width (/ (getdist "\nEnter the pipe width.") 2.0))

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  offset the center line     
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (setq pipecl (vlax-ename->vla-object ent))
  (setq pipe1 (vlax-invoke pipecl 'offset width))
  (setq pipe2 (vlax-invoke pipecl 'offset (- width)))

  ;;  change the line types used  [ for use later ]
  ;; (vla-put-linetype (vlax-ename->vla-object pipe1) lintype)
  ;; (vla-put-linetype (vlax-ename->vla-object pipe2) lintype)
  ;; (vla-put-linetype (vlax-ename->vla-object pipecl) lintype)

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  get the center line length
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (setq txt (rtos (vlax-curve-getdistatpoint pipecl
                    (vlax-curve-getendpoint pipecl)
                  )))

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;   Let user pick text point 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (setvar "osmode" 512)
  (setq txtpt (getpoint "\nSpecify label location on line: "))

  ;;  get a point exactly on the line
  (setq txtpt (vlax-curve-getclosestpointto pipecl txtpt))

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  get the segment angle 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+
  (setq par (vlax-curve-getparamatpoint pipecl txtpt))
  (setq ang (angle (vlax-curve-getpointatparam pipecl (fix par))
                   (vlax-curve-getpointatparam pipecl (fix (1+ par)))
            )
  )
  ;; Convert  Radians to Degrees
  (setq ang (* 180.0 (/ ang pi)))
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+


 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  put the text on the segment 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
               
  ;; If text height is undefined (signified by 0 in the table)
  (if (= (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
    ;; Draw the text using the current text height (textsize)
    (command "text" "c" txtpt "" Ang txt)
    ;; Otherwise use the defined text height
    (command "text" "c" txtpt Ang txt)
  ) ; endif



  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ;;  restore system variables
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+
  (setvar "CMDECHO" usrcmd)
  (setvar "osmode" usros)
  (setvar "plinewid" usrplw)
  (princ)
)

[V-Man]

Take a crack at the cleaned up version. 

Code: [Select]

(defun C:DP (/        errexit dimplx    findparent
     angtos_d  dindstr findstrf  newstr    p1
     p2        bearing len    dist      switch
     inspt     p
    )

  (defun errexit (s)
    (princ "\nError:  ")
    (princ s)
    (restore)
  )

  (defun dimplx ()
    (setvar "ATTDIA" (nth 1 oldvar))
    (setvar "CECOLOR" (nth 2 oldvar))
    (setvar "CMDECHO" (car oldvar))
    (setq *error* olderr)
    (princ)
  )

  (defun angtos_d (brg)
    (setq brg (angtos brg 4 4))
    (newstr (newstr brg "d" "%%d ") "'" "' ")
  )

  (defun findparent (ent)
    (while (and
     (setq ent (entnext ent))
     (/= (cdr (assoc 0 (setq edata (entget ent)))) "SEQEND")
   )
    )
    (if ent
      (cdr (assoc -2 edata))
    )
  )

  (defun findstr (str find len / pos ret match)
    (if len
      (if (zerop len)

(defun match (s)
  (wcmatch s find)
)

(defun match (s)
  (wcmatch (if (substr s 1 len)
     find
   )
  )
)
      )

      (defun match (s)
(= (substr s 1 (strlen find)) find)
      )
    )
    (setq pos (1+ (strlen str)))
    (while (> (setq pos (1- pos)) 0)
      (if (match (substr str pos))
(setq ret (cons pos ret))
      )
    )
    ret
  )

  (defun findstrf (str find len)
    (car (findstr str find len))
  )

  (defun newstr (str old new / pos)
    (if (setq pos (findstr str old nil))
      (foreach p (reverse pos)
(setq str (strcat (substr str 1 (1- p))
  new
  (substr str (+ p (strlen old)))
  )
)
      )
      str
    )
  )

;*******  MAIN PROGRAM  ********
  (setq oldvar (list (getvar "CMDECHO")
     (getvar "ATTDIA")
     (getvar "CECOLOR")
       )
  )
  (setq olderr *error*
restore dimplx
*error* errexit
  )
  (SETVAR "ATTDIA" 0)
  (SETVAR "USERR1" 0.08333)
  (setvar "CMDECHO" 0)
  (setvar "userr2" 1)
  (if (and
(setq p1 (getpoint "\nPick base point: "))
(setq p2 (getpoint p1 "\nPick next point: "))
      )
    (progn
      (setvar "USERR3" 0)
      (setq inspt   (getvar "lastpoint")
    dist    (* (getvar "USERR1")
       (setq len (distance p1 p2))
    )
    bearing
    (angle p1 p2)
    inspt   (polar p1
   bearing
   (if inspt
     (* len
(/ (setq p (distance p1 inspt))
   (+ p (distance p2 inspt))
)
     )
     (/ len 2.0)
   )
    )
      )
      (if (and
    (> bearing (/ pi 2.0))
    (<= bearing (* pi 1.5))
  )
(setq switch (+ bearing pi))
      )
      (COMMAND "._MLINE" "S" "1" "")
      (command
"._mline"
p1
p2
""
(PRINC
  "\nDONE! Type DP For New Run of Same Size or Pick New Size From Pull-Down"
)
(command "._explode" "l")
      )
      (command "._INSERT"
       ""
       inspt
       (* (getvar "DIMTXT")
  (getvar "USERR2")
       )
       ""
       (/ (* (if switch
       switch
       bearing
     )
     180.0
  )
  pi
       )
       (if switch
(strcat (rtos dist 2 2) "'")
(strcat (rtos dist 2 2) "'")
       )
      )
      (command "change" "last" "" "p" "la" "atext" "")
      (SETVAR "ATTREQ" 1)
      (setvar "ATTDIA" 1)
      (setvar "ATTDIA" (nth 1 oldvar))
      (setvar "CECOLOR" (nth 2 oldvar))
    )
  )
)


[eric]

OK I am officially over my head.

I have put a couple of keyboard macros together before. see example:

(defun c:sqc ()

 (command "tilemode" "0")
 
 (command "zoom" "e")

 (command "-layer" "on" "*" "")

 (command "-purge" "all" "" "n")

 (command "qsave")

 (command "close")
)


This works fine for me.  Its simple and straight forward.  But when I started looking at this 2d pipe line project I find myself way over matched.  This is what I have done so far (which is not much and it doesn't work)

(defun c:4CP ()

 (command "MLINE" "st" "4pipe")

 (command "EXPLODE" "l" "")


)


I then thought to myself that I really needed to define exactly what I wanted the code to do step by step. 

1. insert predefined Multiline (size run needed would be 1/4" thru 70") between two points
2. explode Multiline after insertion

Question here - Would I need to write a separate routine for each size run or could all the size runs be incorporated in one program?

At this point I am not quite sure of which direction to go.  I would like calculate the sum of user selected centerlines using this routine

;; Program to sum length of lines & polylines
;; By Carl Bassler October 2000
(princ "\nDetermines sum of length of lines and polylines")
(princ "\nStart with 'sum'")
(defun c:sum ()
  (setvar "cmdecho" 0)
  (princ "\nSelect items to sum lengths")
  (setq set1 (ssget '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "POLYLINE") (0 . "LINE") (-4 . "or>"))))
  (setq len (sslength set1) itemno 0 linesum 0.0)
  (repeat len
    (setq ename (ssname set1 itemno))
    (setq entype (dxf 0 ename))
    (if (or (= entype "LWPOLYLINE") (= entype "POLYLINE")) (progn
        (command ".area" "o" ename)
        (setq linelen (getvar "perimeter"))
    )) ; progn & if
    (if (= entype "LINE") (setq linelen (distance (dxf 10 ename) (dxf 11 ename))))
    (setq linesum (+ linesum linelen))
    (setq itemno (1+ itemno))
  ) ; repeat
  (princ (strcat "\nTotal length of " (itoa len) " items= " (rtos linesum)))
  (princ)
) ; sum defun
;;
;; ***** "dxf" -takes dxf code and entity name, returns data element of the
;; dxf association pair
(defun dxf (code entyname)
  (cdr (assoc code (entget entyname)))
) ; defun
(princ)                           

I would then like to take the generated sum and apply it to a qty field that is embedded in the attribute which coresponds with the size and material of the pipe run.  This information would then be extracted to a bill of material. Or another way would be to have an attribute inserted with every instance of pipe length drawn with the length of that pipe is inserted the qty field.

[Andrea]

just a hint..

if you want to use a AutoCAD command ...dont forget to put an _. before the command
to compatible with other language version.

[eric]

dumb question:  how do I seperate the two functions shown in my code so that I can pick the points I want to draw before they are exploded

[eric]

Many thanks to Cab and dvarino for their code. 

Perhaps you both can provide guidence as I move forward with this project. 

dvarino- I do however get an error message while running your rountine:

Command: dp

Pick base point:
Pick next point:
DONE! Type DP For New Run of Same Size or Pick New Size From Pull-Down
Invalid block name.

Error:  Function cancelled

I looked for where a block was called out for in the code but could not find it.

[t-bear]

Keith....there seems to be an error in your routine.  whenever I run it, my boss pops up on the screen...kinda like..... :ugly: :realmad: :ugly:
What can I do to fix this?

[CAB]

eric,
Sorry I haven't been back to this thread but you asked about the command line
use when you want a point from the user. Put a pause in the command.

This will pause exactly twice and nothing more. The "" ends the command.
(command "MLINE" pause pause "")

If you want you can get an infinite number of points or other input by using this.

;;;;   repeat a point input until Enter
(command "._mline")
(while (> (getvar "CMDACTIVE") 0)
  (command pause)
)

[Kenny]

Your boss is using the old method of protecting lisp code called "The Eric Method".
The name "Eric" of course comes from one of the Monty Python Team.

It used to work well 'cos all it basically does - ignoring all the comments and crap like that - is send you around in circles by loading and unloading all sorts of functions/routines/sub-routines, etc, etc. If one or all are not present at the time of climax, nothing will work.

To expand:

You will find that if you do not have certain variables and/or functions loaded from either your ACAD.LSP/ACADDOC.LSP/HISCUSTOMMENU.MNL and including checks and balances within each lisp routine, then "CRASH".

Works well for protection against novices and cut-and paste coders.

I'm surprised that not one of you know about the "Eric" method.  :pissed:

P.S. Another method called "Rodney" is a way of placing "dummy" code/variables that do nothing within your "real" code so that you can track the cut-and-paste coders.

[Keith™]

P.S. Another method called "Rodney" is a way of placing "dummy" code/variables that do nothing within your "real" code so that you can track the cut-and-paste coders.

Dangit t-bear ... how did Kenny find out about your little scheme?