Topic: Trim or maybe not?

[TimSpangler]

I have some code that I have been using that seems to wor fine but I would like to tweak it abit so that I do not have to trim anything after the fact.  The code is below:

Code: [Select]

;;; ------------------------------------------------------------------------
;;;    Wall.lsp v1.3
;;;
;;;    Copyright © March, 2005
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;    WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;    PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;;    PROGRAMMER.
;;;
;;;    Wall:
;;; This program is used to create 2d walls in the plan view.
;;; It has options for wall thickness and layer
;;;
;;; -----------------------------------------------------------------------

;;; ------------ MAIN FUNCTION
(defun C:WALL (/)

;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)

(if (not (member MSG '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
(princ "\n... Program Cancelled ...")
)
(while (< 0 (getvar "cmdactive"))
(command)
)
(princ)
)
;;; End Error Handler ---------------------------------------------------

;; Enter Main Routine
(LOOP)
)
;; Main Loop Section
(defun LOOP (/)

;; Check for globals
(if(not WallLayer)
(WALL_LAYER)
)
(if(not WallThickness)
(WALL_THICK)
)

(initget "Wall Thickness TH L Layer")
(setq Point1 (getpoint (strcat "\nWall (TH)ickness (" (rtos WallThickness) ") / Layer (" NLayer ") <first point>: ")))
(cond
((= Point1 "Wall") (WALL_THICK))
((= Point1 "Thickness") (WALL_THICK))
((= Point1 "TH") (WALL_THICK))
((= Point1 "L") (WALL_LAYER))
((= Point1 "Layer") (WALL_LAYER))
((and (/= Point1 "Set-thick") (/= Point1 "Type")) (CREATE_WALL))
)
)
;; Entmake the wall lines
(defun MAKE_LINE (PointA PointB LineLayer / NewLine)

(entmake
(list
'(0 . "LINE")
(cons 8  LineLayer)
(cons 10 PointA)
(cons 11 PointB)
)
)
)

;; Layer creation rouine
(defun CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList)

;; Create a list for entmake
  (setq TmpList
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(70 . 0)
)
  )
  ;; Create layer name list
  (setq TmpList (append TmpList (list (cons 2 Layer))))
  ;; Create layer color list
  (setq TmpList (append TmpList (list (cons 62 (atoi Color)))))
  ;; Create layer linetype list
  (setq TmpList (append TmpList (list (cons 6 Linetype))))
  ;; Create layer lineweight list
  (setq TmpList (append TmpList (list (cons 370 (atoi Thickness)))))
  ;; Create layer plot list
  (setq TmpList (append TmpList (list (cons 290 (atoi Plot)))))
  ;; Create layer from first item in the list
  (entmake TmpList)      
  ;; Create layer description
  (if(or(= 16.1 (atof(getvar "acadver")))(< 16.1 (atof(getvar "acadver"))))
     (progn
        (setq VLA-Obj(vla-Add (vla-Get-Layers (vla-Get-ActiveDocument(vlax-Get-Acad-Object)))Layer))
        (vla-Put-Description VLA-Obj Descpition)
     )
  )
)
;; Create wall Layers - Edit layer info here for your own use
(defun WALL_LAYER ()

(initget 1 "1 2")
(setq WallLayer (getkword "<1 - A-WALL-EXTR> <2 - A-WALL-INTR>"))
(cond
((= WallLayer "1")(CREATE_LAYER "A-WALL-EXTR" "Exterior full height walls" "Continuous" "50" "53" "1"))
((= WallLayer "2")(CREATE_LAYER "A-WALL-INTR" "Interior full height walls" "Continuous" "50" "113" "1"))
)
(cond
((= WallLayer "1")(setq NLayer "A-WALL-EXTR"))
((= WallLayer "2")(setq NLayer "A-WALL-INTR"))
)
(LOOP)
)
;; Wall thickness section
(defun WALL_THICK (/)

(setq WallThickness (getreal "\nEnter Wall Thickness:"))
(LOOP)
)

;; Wall creation section
(defun CREATE_WALL ( / )

(if(not Point1)
(setq Point1 (getpoint "\nSelect Start Point")) )
(setq Point2 (getpoint Point1 "\nSelect End Point"))

(setq Angle1 (angle Point1 Point2))
(setq Point1A (polar Point1 (+ Angle1 (/ PI 2)) (+ 0.5 WallThickness)))
(setq Point2A (polar Point2 (+ Angle1 (/ PI 2)) (+ 0.5 WallThickness)))
(setq Point1B (polar Point1 (+ Angle1 (/ PI 2)) 0.5))
(setq Point2B (polar Point2 (+ Angle1 (/ PI 2)) 0.5))
(setq Point1C (polar Point1 (+ Angle1 (/ PI 2)) (+ 1 WallThickness)))
(setq Point2C (polar Point2 (+ Angle1 (/ PI 2)) (+ 1 WallThickness)))

(MAKE_LINE Point1 Point2 NLayer)
(MAKE_LINE Point1A Point2A NLayer)
(MAKE_LINE Point1B Point2B NLayer)
(MAKE_LINE Point1C Point2C NLayer)

(while Point2
(setq Point1 Point2)
(setq Point2 (getpoint Point1 " \nSelect Next Point"))
(setq Angle1 (angle Point1 Point2))
(setq Point1A (polar Point1 (+ Angle1 (/ PI 2)) (+ 0.5 WallThickness)))
(setq Point2A (polar Point2 (+ Angle1 (/ PI 2)) (+ 0.5 WallThickness)))
(setq Point1B (polar Point1 (+ Angle1 (/ PI 2)) 0.5))
(setq Point2B (polar Point2 (+ Angle1 (/ PI 2)) 0.5))
(setq Point1C (polar Point1 (+ Angle1 (/ PI 2)) (+ 1 WallThickness)))
(setq Point2C (polar Point2 (+ Angle1 (/ PI 2)) (+ 1 WallThickness)))

(MAKE_LINE Point1 Point2 NLayer)
(MAKE_LINE Point1A Point2A NLayer)
(MAKE_LINE Point1B Point2B NLayer)
(MAKE_LINE Point1C Point2C NLayer)
)
)

I use this to create 2d walls and it create them no proplem but as you an see ther is alot of filleting after the fact.  What I would like to do is make it more like the mline command this way there is no trimming.

This will be a learning process for  me as well, I haven't done much with line or point manipulation with lisp.

Can anyone help me?

[Jeff_M]

Tim,
Not related to this routine in particular, but rather a general note.....this line:
(initget "Wall Thickness TH L Layer")
is identical to this line:
(initget "Wall Thickness Layer")
The reason being, if the user enters anypart that starts with the capitalized letter of the keyword then the entire keyword is returned....witnesseth:

Code: [Select]


(repeat 10
  (initget "Wall Thickness Layer")
  (setq temp (getkword "\nWall Thickness Layer :"))
  (princ (strcat " ..... You entered \"" temp "\""))
  )

Wall Thickness Layer :w
 ..... You entered "Wall"
Wall Thickness Layer :Wa
 ..... You entered "Wall"
Wall Thickness Layer :L
 ..... You entered "Layer"
Wall Thickness Layer :l
 ..... You entered "Layer"
Wall Thickness Layer :Laye
 ..... You entered "Layer"
Wall Thickness Layer :t
 ..... You entered "Thickness"
Wall Thickness Layer :T
 ..... You entered "Thickness"
Wall Thickness Layer :TH
 ..... You entered "Thickness"
Wall Thickness Layer :thic
 ..... You entered "Thickness"
Wall Thickness Layer :w
 ..... You entered "Wall"
[/list:u]

[Jeff_M]

I have some code that I have been using that seems to wor fine but I would like to tweak it abit so that I do not have to trim anything after the fact.  

This will be a learning process for  me as well, I haven't done much with line or point manipulation with lisp.

Can anyone help me?

Well, I don't know if this will help you or confuse you. I purposely didn't use any type of code reduction funtions so that you could follow the process I used. I did loosely follow your intent so that you can 'almost' just plug this into your code and go with it. Note that I added a Close option to finish a room/structure. Try it out by itself, then step through it to see what each part does, then finally incorporate what you like into your routine.

Code: [Select]


(defun c:jwall (/ doc int2 int3 int4 line1 line2 line3 line4 line5 line6
line7 line8 point1 point2 space start1 start2 start3
start4 startpt wall-thick)
  (setq doc   (vla-get-activedocument (vlax-get-acad-object))
space   (if (= (getvar "cvport") 1)
    (vla-get-paperspace doc)
    (vla-get-modelspace doc)
  )
wall-thick (getreal "\nWall thickness? ")
point1   (getpoint "\nStart point: ")
startPt   point1
point2   (getpoint point1 "\nNext point")
line1   (vlax-invoke space 'addline point1 point2)
start1   line1
line2   (car (vlax-invoke line1 'offset 0.5))
start2   line2
line3   (car (vlax-invoke line2 'offset wall-thick))
start3   line3
line4   (car (vlax-invoke line3 'offset 0.5))
start4   line4
point1   point2
  )
  (while (progn
  (initget "Close")
  (setq point2 (getpoint point1 "\nNext point: "))
  (= (TYPE point2) 'LIST)
)
    (setq line5 (vlax-invoke space 'addline point1 point2)
 line6 (car (vlax-invoke line5 'offset 0.5))
 line7 (car (vlax-invoke line6 'offset wall-thick))
 line8 (car (vlax-invoke line7 'offset 0.5))
    )
    (setq int2 (vlax-invoke line2 'intersectwith line6 acExtendBoth)
 int3 (vlax-invoke line3 'intersectwith line7 acExtendBoth)
 int4 (vlax-invoke line4 'intersectwith line8 acExtendBoth)
    )
    (vlax-put line2 'endpoint int2)
    (vlax-put line3 'endpoint int3)
    (vlax-put line4 'endpoint int4)
    (vlax-put line6 'startpoint int2)
    (vlax-put line7 'startpoint int3)
    (vlax-put line8 'startpoint int4)
    (setq line1 line5
 line2 line6
 line3 line7
 line4 line8
 point1 point2
    )
  )
  (if (= point2 "Close")
    (progn
      (setq line5 (vlax-invoke space 'addline point1 startpt)
   line6 (car (vlax-invoke line5 'offset 0.5))
   line7 (car (vlax-invoke line6 'offset wall-thick))
   line8 (car (vlax-invoke line7 'offset 0.5))
      )
      (setq int2 (vlax-invoke line2 'intersectwith line6 acExtendBoth)
   int3 (vlax-invoke line3 'intersectwith line7 acExtendBoth)
   int4 (vlax-invoke line4 'intersectwith line8 acExtendBoth)
      )
      (vlax-put line2 'endpoint int2)
      (vlax-put line3 'endpoint int3)
      (vlax-put line4 'endpoint int4)
      (vlax-put line6 'startpoint int2)
      (vlax-put line7 'startpoint int3)
      (vlax-put line8 'startpoint int4)
      ;;now close it.....
      (setq int2 (vlax-invoke start2 'intersectwith line6 acExtendBoth)
   int3 (vlax-invoke start3 'intersectwith line7 acExtendBoth)
   int4 (vlax-invoke start4 'intersectwith line8 acExtendBoth)
      )
      (vlax-put line6 'endpoint int2)
      (vlax-put line7 'endpoint int3)
      (vlax-put line8 'endpoint int4)
      (vlax-put start2 'startpoint int2)
      (vlax-put start3 'startpoint int3)
      (vlax-put start4 'startpoint int4)
    )
  )
  (princ)
)


BTW, I went with ActiveX over the standard lisp (entmake)/(entmod) because it is sooooo much easier to follow what the code is doing. Note- To place the linework on the desired layer use the format of (vla-put-layer linevar layervar) immediately after creating the line.
For instance:

Code: [Select]


      (setq line5 (vlax-invoke space 'addline point1 startpt)
   line6 (car (vlax-invoke line5 'offset 0.5))
   line7 (car (vlax-invoke line6 'offset wall-thick))
   line8 (car (vlax-invoke line7 'offset 0.5))
      )
    (vla-put-layer line5 wallLayer)
    (vla-put-layer line6 wallLayer)
    (vla-put-layer line7 wallLayer)
    (vla-put-layer line8 wallLayer)


[Jeff_M]

Word of caution.....you must allow for the user selecting the Next Point that is in the same direction as the last line and also for closing onto the start point in the same direction as the first line, else the 'intersectwith will fail.....

[TimSpangler]

Jeff,

you the man.  That is a sweet piece of code.  Give a day or so to digest this little beauty.  I may have a few questions

Thanks Again