Free LISP : LISP commands to work faster in 3D

LISP commands to work faster in 3D

     Here are some LISP program created short cut commands to help user work faster in 3D mode.

VIEW MODE

This LISP program to create short command to change current view to be ISOMETRIC view

(defun c:viso ()

  (command "._viewpoint" "1,-1,1" "")

)

CREATE MODE

• EXTRUDE multiple closed polyline

(defun c:ex1 ( / ss i ent height )

  (setq ss (ssget '((0 . "LWPOLYLINE")))) ; Select closed polyline

  (if ss

    (progn

      (setq height (getreal "\n Height to Extrude: "))

      (setq i 0)

      (while (< i (sslength ss))

        (setq ent (ssname ss i))

             (command "_FMEXTRUDE" ent "" height)

        (setq i (1+ i))

      )

    )

    (princ "\n no closed polyline selected")

  )

)

• Create ROOF GABLE from closed polyline

; command is GB1

(defun midpoint (p1 p2)

  (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)

)

(defun raise-point (pt h)

  (list (car pt) (cadr pt) (+ (caddr pt) h))

)

(defun ensure-3d (pt)

  (if (= (length pt) 2)

    (append pt (list 0.0))

    pt

  )

)

(defun distance-3d (p1 p2)

  (distance p1 p2)

)

(defun Mid4P (  pt1 pt2 pt3 pt4 / cx cy )

 ; (prompt "\nSelect 4 points:")

  ;(setq pt1 (getpoint "\nPoint 1: "))

 ; (setq pt2 (getpoint "\nPoint 2: "))

 ; (setq pt3 (getpoint "\nPoint 3: "))

 ; (setq pt4 (getpoint "\nPoint 4: "))

  ;; find center point 

  (setq cx (/ (+ (car pt1) (car pt2) (car pt3) (car pt4)) 4.0))

  (setq cy (/ (+ (cadr pt1) (cadr pt2) (cadr pt3) (cadr pt4)) 4.0))

  (setq center (list cx cy))

)

(defun c:GB1 ( / ent elst pts p1 p2 p3 p4 ridge1 ridge2 h len1 len2 ridgeMid1 ridgeMid2 center )

  (setq ent (car (entsel "\nSelect closed 4-sided polyline: ")))

  (setq elst (entget ent))

  (if (and ent (= (cdr (assoc 0 elst)) "LWPOLYLINE"))

    (progn

      ;; Extract 4 vertices

      (setq pts '())

      (foreach item elst

        (if (= (car item) 10)

          (setq pts (append pts (list (ensure-3d (cdr item)))))

        )

      )

      (if (= (length pts) 4)

        (progn

          (setq p1 (nth 0 pts)

                p2 (nth 1 pts)

                p3 (nth 2 pts)

                p4 (nth 3 pts))

          ;; Ask user for roof height

          (setq h (getreal "\nEnter roof height (slope): "))

          ;; Measure lengths of two opposing sides

          (setq len1 (distance-3d p1 p2)) ; side 1-2 vs 3-4

          (setq len2 (distance-3d p2 p3)) ; side 2-3 vs 4-1

          ;; Determine ridge direction: along the shorter opposing side

          (if (< len1 len2)

            (progn

              (setq ridgeMid1 (midpoint p1 p2))

              (setq ridgeMid2 (midpoint p3 p4))

         (setq ridge1 (raise-point ridgeMid1 h))

          (setq ridge2 (raise-point ridgeMid2 h))

          (command "3DFACE" p1 p2 ridge1 ridge1 "")

          (command "3DFACE" p2 p3 ridge2 ridge1 "")

          (command "3DFACE" p3 p4 ridge2 ridge2 "")

          (command "3DFACE" p4 p1 ridge1 ridge2 "")

            )

            (progn

              (setq ridgeMid1 (midpoint p2 p3))

              (setq ridgeMid2 (midpoint p4 p1))

         (setq ridge1 (raise-point ridgeMid1 h))

          (setq ridge2 (raise-point ridgeMid2 h))

          (command "3DFACE" p1 p2 ridge1 ridge2 "")

          (command "3DFACE" p2 p3 ridge1 ridge1 "")

          (command "3DFACE" p3 p4 ridge2 ridge1 "")

          (command "3DFACE" p4 p1 ridge2 ridge2 "")

            )

          )

          ;; Raise ridge points

          (setq ridge1 (raise-point ridgeMid1 h))

          (setq ridge2 (raise-point ridgeMid2 h))

          (princ "\n Gable roof created from 4-sided polyline.")

        )

        (princ "\nPolyline must have exactly 4 vertices.")

      )

    )

    (princ "\nInvalid selection. Please select a closed 4-sided polyline.")

  )

  (princ)

)