Author Topic: 2d pipe lisp  (Read 16002 times)

0 Members and 1 Guest are viewing this topic.

eric

  • Guest
2d pipe lisp
« on: September 22, 2005, 09:32:15 AM »
I would like to write a lisp routine that would allow me to insert a 2d pipe run in between two points.  Then calculate the length of pipe drawn and return that value to an attribute which would need to be inserted just above the centerline.  Can anyone help?

ronjonp

  • Needs a day job
  • Posts: 7529
Re: 2d pipe lisp
« Reply #1 on: September 22, 2005, 10:49:21 AM »
Not exactly what you are looking for but this routine will allow you to select all the pipe segments and it will place the length in text at the midpoint.

Code: [Select]
;Puts text with objects length------Many thanks to the SWAMP.ORG for all the help

(defun c:rlt (/ *error* u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_length txt)
  (command ".undo" "begin") 
(vl-load-com)

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'clayer u-clayer)
    (princ)
  ) ;end error function

;_____________________________
;Get User Variables
;_____________________________

(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "length")
  (command "-layer" "thaw" "length" "on" "length" "")
  (princ "\n Layer 'length' Created")
)
(command ".-layer" "m" "length" "")
 
  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )
  (if (setq sl (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE"))

               )
      )
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )
        (setq obj_length (vlax-get-property obj 'LENGTH))
        (setq txt (strcat (rtos obj_length)))
        (command "text" "j" "mc" mpt (* (getvar "dimscale") 0.15) "0" txt)
        (princ)
      )
    )
  )
(command ".undo" "end")
(princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(princ)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

eric

  • Guest
Re: 2d pipe lisp
« Reply #2 on: September 22, 2005, 11:03:29 AM »
Thanks, ronjonp.  You right its not exactly what I am looking for.  But it is a usefull tool.

eric

  • Guest
Re: 2d pipe lisp
« Reply #3 on: September 22, 2005, 11:14:38 AM »
Just an addition I have already created the attribute tag.  Within the tag I have predefined several fields ie. size, spec, description, qty.  All except the qty field are static.  The returned value from the length of pipe drawn would need to be reflected in this qty field.

eric

  • Guest
Re: 2d pipe lisp
« Reply #4 on: September 22, 2005, 11:22:49 AM »
this is the code our cad manager wrote.  although I cant seem to get it to work.

** edit by MST **
removed code, will attach attach as file
« Last Edit: September 22, 2005, 01:20:37 PM by Mark Thomas »

deegeecees

  • Guest
Re: 2d pipe lisp
« Reply #5 on: September 22, 2005, 11:28:21 AM »
What type of code is that? I've never come across this before.  :?

LE

  • Guest
Re: 2d pipe lisp
« Reply #6 on: September 22, 2005, 11:29:28 AM »
That CM.... is really afraid to loose his job.....

Post an image showing what is the end result, you are looking for....
« Last Edit: September 22, 2005, 11:37:00 AM by LE »

deegeecees

  • Guest
Re: 2d pipe lisp
« Reply #7 on: September 22, 2005, 11:31:23 AM »
Is he numbering every line of code?  :-o

eric

  • Guest
Re: 2d pipe lisp
« Reply #8 on: September 22, 2005, 11:55:33 AM »
LE - I think it is not fear but cautious paranoid. (is politically correct?)

eric

  • Guest
Re: 2d pipe lisp
« Reply #9 on: September 22, 2005, 12:02:09 PM »
Here is an example of what I am looking for.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: 2d pipe lisp
« Reply #10 on: September 22, 2005, 12:26:50 PM »
Dude that code is atrocious ... it hurts me just to look at it ..
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

LE

  • Guest
Re: 2d pipe lisp
« Reply #11 on: September 22, 2005, 01:05:20 PM »
LE - I think it is not fear but cautious paranoid. (is politically correct?)

Code: [Select]
if (cautious == paranoid) {

bs("Does not know what he is doing");

}

eric

  • Guest
Re: 2d pipe lisp
« Reply #12 on: September 22, 2005, 01:14:02 PM »
Tell me about it Keith.  I am going to attempt to write something myself.  I cant see it being as complicated as my CM is making it out to be.

LE

  • Guest
Re: 2d pipe lisp
« Reply #13 on: September 22, 2005, 01:21:18 PM »
Eric,

See if you can adapt the following code on what you are looking for... Is an old code I used to draw plywood

Code: [Select]
(defun rcmd-rtd (a) (* (/ a pi) 180.0))

(setq :rcm45Degrees (* pi 0.25))
(setq :rcm90Degrees (* pi 0.5))
(setq :rcm135Degrees (* pi 0.75))
(setq :rcm225Degrees (* pi 1.25))
(setq :rcm270Degrees (* pi 1.5))
(setq :rcm315Degrees (* pi 1.75))
(setq :rcm360Degrees (* pi 2.0))

(if (not :rcmAtemp) (setq :rcmAtemp 0.0))

(defun rcmd-plywood  (thick /    p1   p2   p3   p4 l1   ang  code
      g1   g2 g3   g4   g1a  g2a  g3a g4a  oct  g4b
      g1b  g3b g2b  ply)
  (initget 8)
  (setvar "blipmode" 1)
  (setvar "osmode" 0)
  (setq p1 (getpoint "\nFirst end: "))

  (setvar "blipmode" 0)
  (prompt "\nDrag for direction: ")
  (setq
    ang (getangle
  (strcat "\nAlignment angle <"
  (rtos (rcmd-rtd :rcmAtemp) 2 0)
  ">: ")
  p1))
  (if (= ang nil)
    (setq ang :rcmAtemp)
    (setq :rcmAtemp ang))

  (setq code 5)
  (setvar "osmode" 0)
  (prompt " Other end: ")
  (setq oct 0.125)
  (if (equal thick 0.125)
    (setq ply 0))
  (if (equal thick 0.250)
    (setq ply 1))
  (if (equal thick 0.375)
    (setq ply 2))
  (if (equal thick 0.500)
    (setq ply 3))
  (if (equal thick 0.625)
    (setq ply 4))
  (if (equal thick 0.750)
    (setq ply 5))
  (while (= code 5)
    (setq l1 (grread 1 6 1))
    (if (and p2 p4 (= ply 0))
      (grvecs (list 256 g1 g2 g4 g3)))
    (if (and p2 p4 (= ply 1))
      (grvecs (list 256 g1 g2 g4 g3 p1 p2)))
    (if (and p2 p4 (= ply 2))
      (grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a)))
    (if (and p2 p4 (= ply 3))
      (grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a p1 p2)))
    (if (and p2 p4 (= ply 4))
      (grvecs
(list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b)))
    (if (and p2 p4 (= ply 5))
      (grvecs
(list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b p1 p2)))
    (setq p3   (cadr l1)
  code (car l1)
  p2   (inters p1
       (polar p1 ang 1)
       p3
       (polar p3 (+ ang :rcm90Degrees) 1)
       nil)
  p4   (inters p1
       (polar p1 (+ ang :rcm90Degrees) 1)
       p3
       (polar p3 (+ ang pi) 1)
       nil))
    (if (= ply 0)
      (progn
(setq g3 (polar p2 (angle p1 p4) (/ thick 2))
      g2 (polar p2 (angle p4 p1) (/ thick 2))
      g4 (polar p1 (angle p1 p4) (/ thick 2))
      g1 (polar p1 (angle p4 p1) (/ thick 2)))
(grvecs (list 256 g1 g2 g4 g3))))
    (if (= ply 1)
      (progn
(setq g3 (polar p2 (angle p1 p4) (/ thick 2))
      g2 (polar p2 (angle p4 p1) (/ thick 2))
      g4 (polar p1 (angle p1 p4) (/ thick 2))
      g1 (polar p1 (angle p4 p1) (/ thick 2)))
(grvecs (list 256 g1 g2 g4 g3 p1 p2))))
    (if (= ply 2)
      (progn
(setq g3  (polar p2 (angle p1 p4) (/ thick 2))
      g3a (polar g3 (angle p4 p1) oct)
      g2  (polar p2 (angle p4 p1) (/ thick 2))
      g2a (polar g2 (angle p1 p4) oct)
      g4  (polar p1 (angle p1 p4) (/ thick 2))
      g4a (polar g4 (angle p4 p1) oct)
      g1  (polar p1 (angle p4 p1) (/ thick 2))
      g1a (polar g1 (angle p1 p4) oct))
(grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a))))
    (if (= ply 3)
      (progn
(setq g3  (polar p2 (angle p1 p4) (/ thick 2))
      g3a (polar g3 (angle p4 p1) oct)
      g2  (polar p2 (angle p4 p1) (/ thick 2))
      g2a (polar g2 (angle p1 p4) oct)
      g4  (polar p1 (angle p1 p4) (/ thick 2))
      g4a (polar g4 (angle p4 p1) oct)
      g1  (polar p1 (angle p4 p1) (/ thick 2))
      g1a (polar g1 (angle p1 p4) oct))
(grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a p1 p2))))
    (if (= ply 4)
      (progn
(setq g3  (polar p2 (angle p1 p4) (/ thick 2))
      g3a (polar g3 (angle p4 p1) oct)
      g3b (polar g3a (angle p4 p1) oct)
      g2  (polar p2 (angle p4 p1) (/ thick 2))
      g2a (polar g2 (angle p1 p4) oct)
      g2b (polar g2a (angle p1 p4) oct)
      g4  (polar p1 (angle p1 p4) (/ thick 2))
      g4a (polar g4 (angle p4 p1) oct)
      g4b (polar g4a (angle p4 p1) oct)
      g1  (polar p1 (angle p4 p1) (/ thick 2))
      g1a (polar g1 (angle p1 p4) oct)
      g1b (polar g1a (angle p1 p4) oct))
(grvecs
  (list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b))))
    (if (= ply 5)
      (progn
(setq g3  (polar p2 (angle p1 p4) (/ thick 2))
      g3a (polar g3 (angle p4 p1) oct)
      g3b (polar g3a (angle p4 p1) oct)
      g2  (polar p2 (angle p4 p1) (/ thick 2))
      g2a (polar g2 (angle p1 p4) oct)
      g2b (polar g2a (angle p1 p4) oct)
      g4  (polar p1 (angle p1 p4) (/ thick 2))
      g4a (polar g4 (angle p4 p1) oct)
      g4b
  (polar g4a (angle p4 p1) oct)
      g1  (polar p1 (angle p4 p1) (/ thick 2))
      g1a (polar g1 (angle p1 p4) oct)
      g1b (polar g1a (angle p1 p4) oct))
(grvecs
  (list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b p1 p2)))))
  (if (= ply 0) ; 1/8
    (progn
      (grvecs (list 256 g1 g2 g4 g3))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")))
  (if (= ply 1) ; 1/4
    (progn
      (grvecs (list 256 g1 g2 g4 g3 p1 p2))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywoodInt
;;;;;; :rcmColorPlywoodInt
;;;;;; :rcmLineTypePlywoodInt
;;;;;; nil)

      (command "_.line" p1 p2 "")))
  (if (= ply 2) ; 3/8
    (progn
      (grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywoodInt
;;;;;; :rcmColorPlywoodInt
;;;;;; :rcmLineTypePlywoodInt
;;;;;; nil)

      (command "_.line" g1a g2a "" "_.line" g4a g3a "")))
  (if (= ply 3) ; 1/2
    (progn
      (grvecs (list 256 g1 g2 g4 g3 g1a g2a g4a g3a p1 p2))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywoodInt
;;;;;; :rcmColorPlywoodInt
;;;;;; :rcmLineTypePlywoodInt
;;;;;; nil)

      (command "_.line" g1a g2a "" "_.line" g4a g3a "" "_.line" p1 p2 "")))
  (if (= ply 4) ; 5/8
    (progn
      (grvecs
(list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywoodInt
;;;;;; :rcmColorPlywoodInt
;;;;;; :rcmLineTypePlywoodInt
;;;;;; nil)

      (command "_.line"        g1a     g2a     ""      "_.line"
       g4a     g3a     ""      "_.line"        g4b     g3b
       ""      "_.line"        g1b     g2b     "")))
  (if (= ply 5) ; 3/4
    (progn
      (grvecs
(list 256 g1 g2 g4 g3 g1a g2a g4a g3a g4b g3b g1b g2b p1 p2))

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywood
;;;;;; :rcmColorPlywood
;;;;;; :rcmLineTypePlywood
;;;;;; nil)

      (command "_.line" g1 g2 "" "_.line" g4 g3 "")

;;;;;;      (rcmd-setLayer
;;;;;; :rcmLayerPlywoodInt
;;;;;; :rcmColorPlywoodInt
;;;;;; :rcmLineTypePlywoodInt
;;;;;; nil)

      (command "_.line"        g1a     g2a     ""      "_.line"
       g4a     g3a     ""      "_.line"        g4b     g3b
       ""      "_.line"        g1b     g2b     ""      "_.line"
       p1      p2      "")))
  (redraw)
  (princ))

Code: [Select]
Command: (RCMD-PLYWOOD 0.375)

HTH.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: 2d pipe lisp
« Reply #14 on: September 22, 2005, 01:28:29 PM »
How's this ..
Code: [Select]
Function IsParanoid ( ByVal Empl As Employee ) As Boolean
Dim CM as Dumbass
Set CM = Empl.Boss

If CM.cautious = "paranoid" Then
 CM.value = VbNull
 CM.Title = "Dumbass"
 IsParanoid = True
Else
 IsParanoid = False
End If
End Function
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

eric

  • Guest
Re: 2d pipe lisp
« Reply #15 on: September 22, 2005, 01:33:48 PM »
Well put Keith.  Thanks for the chuckle

Bob Wahr

  • Guest
Re: 2d pipe lisp
« Reply #16 on: September 22, 2005, 03:21:38 PM »
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

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: 2d pipe lisp
« Reply #17 on: September 22, 2005, 07:28:37 PM »
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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Re: 2d pipe lisp
« Reply #18 on: September 22, 2005, 09:25:27 PM »

Take a crack at the cleaned up version.  :laugh:

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))
    )
  )
)
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

eric

  • Guest
Re: 2d pipe lisp
« Reply #19 on: September 23, 2005, 01:44:10 PM »
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

  • Water Moccasin
  • Posts: 2372
Re: 2d pipe lisp
« Reply #20 on: September 23, 2005, 02:54:04 PM »
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.
Keep smile...

eric

  • Guest
Re: 2d pipe lisp
« Reply #21 on: September 23, 2005, 03:02:10 PM »
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

  • Guest
Re: 2d pipe lisp
« Reply #22 on: September 23, 2005, 03:10:43 PM »
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

  • Guest
Re: 2d pipe lisp
« Reply #23 on: September 28, 2005, 02:00:27 PM »
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

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: 2d pipe lisp
« Reply #24 on: September 28, 2005, 02:11:23 PM »
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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Kenny

  • Guest
Re: 2d pipe lisp
« Reply #25 on: September 30, 2005, 03:07:13 PM »
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.
« Last Edit: September 30, 2005, 03:12:30 PM by Kenny »

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: 2d pipe lisp
« Reply #26 on: September 30, 2005, 03:19:33 PM »
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?
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie