Author Topic: Isometric Dimension lisp... help improve?  (Read 4945 times)

0 Members and 1 Guest are viewing this topic.

Russelltimk

  • Guest
Isometric Dimension lisp... help improve?
« on: May 17, 2013, 12:21:01 AM »
Wrote a lisp for Iso Dims a while back based on another lisp I found online. Added some features like isoarrow heads and iso text based on 3 click points.

Users here at my office still hesitate to use the command however. Was wondering if adding grread/redraw to the code would make it more userfriendly for previewing the dimension as you move the mouse around? If this possible to use with rotate dimensions?

Haven't used grread in any code as of yet... any pointers or do I need to rewtire everything in order to use grread?
My codes a bit clunkly... working to try to streamline.
Thanks!

PS. You'll need the isoblock.dwg to run.

Code: [Select]
;isodim.lsp
;Based on design by Bill DeShawn bdeshawn@prodigy.com
;Version 1.0 7-24-2012- First build. Russ
;1.1 11-06-2012- Changed dimstyle names to reduce errors when using with existing drawings. Russ

(defun rtd (A)
   (/ (* A 180.0) PI)
)

;CHANGE DIMSTYLE VAULE OF LAST OBJECT (DIMENSION IN THIS CASE)
(defun ISOLEFT()
(setq DPRES nil
OBJ Nil)
(while (= nil DPRES)
(while (= nil OBJ)(setq OBJ (entlast)))
(setq D (entget obj))
(if (= "DIMENSION" (cdr (assoc 0 D)))
(setq DPRES T)
(setq OBJ nil)
)
)
(setq D (subst '(3 . "ISO DIM LEFT")
(assoc 3 D)
D
)
)
(entmod D)
(prin1)
)

;CHANGE DIMSTYLE VAULE OF LAST OBJECT (DIMENSION IN THIS CASE)
(defun ISORIGHT()
(setq DPRES nil
OBJ Nil)
(while (= nil DPRES)
(while (= nil OBJ)(setq OBJ (entlast)))
(setq D (entget obj))
(if (= "DIMENSION" (cdr (assoc 0 D)))
(setq DPRES T)
(setq OBJ nil)
)
)
(setq D (subst '(3 . "ISO DIM RIGHT")
(assoc 3 D)
D
)
)
(entmod D)
(prin1)
)

;CHANGE DIMSTYLE VAULE OF LAST OBJECT (DIMENSION IN THIS CASE)
(defun ISORV()
(setq DPRES nil
OBJ Nil)
(while (= nil DPRES)
(while (= nil OBJ)(setq OBJ (entlast)))
(setq D (entget obj))
(if (= "DIMENSION" (cdr (assoc 0 D)))
(setq DPRES T)
(setq OBJ nil)
)
)
(setq D (subst '(3 . "ISO DIM Right Vert plane")
(assoc 3 D)
D
)
)
(entmod D)
(prin1)
)





;;////////ERROR TRAPPING

(defun isodimerr (msg) (setq msg "\nCommand Complete")(princ msg)(terpri)
 
   (setvar "snapstyl" snpstl)
   (setq SlopeRound nil ROang nil p1 nil p2 nil p3 nil snpstl nil cmde nil lu nil work nil isoang nil vpang1 nil vpang2 nil vpang3 nil vpang4 nil vpang5 nil vpang6 nil)
   (setq *error* olderr)
   (setvar "orthomode" ortho)
   ;setvar "snapstyl" snpstl)
   (princ)
)



;MAIN PROGRAM
(defun c:isodim (/ ortho snpstl p1 p2 p3 )
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(COMMAND "-PURGE" "BLOCK" "ISODIMBLOCK" "N")
 

 
  ;;Check and see if block for isodimstyle has been loaded into drawing
  (if (tblsearch "BLOCK" "isodimblock" )  ; --> if not present insert to get dimstyles
  (princ "Entering ISOMETRIC DIMENSION mode (command ISODIM)" )
      (progn
      (setvar "cmdecho" 0)
      (command "-insert" "isodimblock.dwg" "0,0" "" "" "")
  (command "_erase" "last" "")
      (setvar "cmdecho" cmde)
  (princ "Entering ISOMETRIC DIMENSION mode (command ISODIM)" )
);end progn
);end if

 
(setq snpstl (getvar "snapstyl"))
  (setq dimst (getvar "dimstyle"))
   (setq ortho (getvar "orthomode"))
   (setvar "orthomode" 0) ;TEMPORARILY TURNS OFF ORTHO (F8)
   (setq olderr *error*)
   (setq *error* isodimerr)
   
   

 

(setvar "snapstyl" 1)
   (setq p1 (getpoint "\nFirst point: "))
   (if (not p1)
      (progn
         (setq ent (nentsel "\nPick line:  "))
         (setq elist (entget (car ent)))
         (setq p1 (cdr (assoc 10 elist)))
         (setq p2 (cdr (assoc 11 elist)))
         (if (not p2)
            (progn
               (alert "Polylines can't be done that way!\nPick a second point on Polyline.")
            (setq p2 (getpoint p1 "\nPolylines can't be done that way.  2nd point:  ")))
         )
      )
   )
   (if (not p2)
     (setq p2 (getpoint p1 "\nSecond point:  "))
     
   )

 
 (setq p3 (getpoint p2 "\n Pick point for iso direction:  "))
(setvar "cmdecho" 0)
    (setq ang (rtd (angle p2 p3)))
(setq ROang (rtd (angle p1 p2)))



;;; ROUND
;;; Rounds a number to the closest value according to precision argument
;;; (round pi 0.01) -> 3.14
;;; (round pi 1e-5) -> 3.14159
;;; (round 5456.50 1.0) -> 5457.0
;;; (round 5456.50 100.0) -> 5500.0
 
(defun round (num prec)
  (if (< 0 prec)
    (* prec
       (fix (if    (minusp num)
          (- (/ num prec) 0.5)
          (+ (/ num prec) 0.5)
        )
       )
    )
    num
  )
)


(setq SlopeRound (round ROang 30))
(command "dimrotated"  SlopeRound P1 P2 P3)

 
  ;;///// 30 degree logic
 
   (if (and (<= ang 60.00)(> ang 0.00))
     (progn
       (setq vpang1 (rtd (angle p1 p2)))
       (setq isoang 30.00)
       (setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)

(cond
  ((and(> vpang1 70)(< vpang1 110))(ISORV));OK
   ((and(> vpang1 250)(< vpang1 290))(ISORV));ok
    ((and(> vpang1 110.00)(< vpang1 250.00))(ISORIGHT));ok
     ((< vpang1 70)(ISORIGHT));ok
      ((and(> vpang1 110)(< vpang1 250))(ISORIGHT));ok
       ((> vpang1 290)(ISORIGHT));ok
  )
))


 
  ;;///// 90 degree logic
   (if (and (<= ang 120.00)(> ang 60.00))
     (progn
       (setq vpang2 (rtd (angle p1 p2)))
       (setq isoang 90.00)
(setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)    


(cond
  ((AND(> vpang2 270)(< vpang2 360))(ISOLEFT));ok
   ((AND(> vpang2 90)(< vpang2 180))(ISOLEFT)) ;ok
    (if(= isoang 90.00)(isoright));ok
  )))

 
   
 
;;////////////////////////////////////////////////////////////////////////////////////////////




 ;;///// 150 degree logic
   (if (and (<= ang 180.00)(> ang 120.00))
     (progn
       (setq vpang3 (rtd (angle p1 p2)))
       (setq isoang 150.00)
       (setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)
       
(cond
  ((and(> vpang3 70)(< vpang3 110))(ISORIGHT));OK
   ((and(> vpang3 250)(< vpang3 290))(ISORIGHT));ok
    ((and(> vpang3 110.00)(< vpang3 250.00))(ISOLEFT));ok
     ((< vpang3 70)(ISOLEFT));ok
      ((and(> vpang3 110)(< vpang3 250))(ISOLEFT));ok
       ((> vpang3 290)(ISOLEFT));ok
  )
))

 
 
 ;;///// 210 degree logic
 
   (if (and (<= ang 240.00)(> ang 180.00))
     (progn
       (setq vpang4 (rtd (angle p1 p2)))
       (setq isoang 210.00)
       (setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)
 

(cond
((and(> vpang4 70)(< vpang4 110))(ISORV));OK
   ((and(> vpang4 250)(< vpang4 290))(ISORV));ok
    ((and(> vpang4 110.00)(< vpang4 250.00))(ISORIGHT));ok
     ((< vpang4 70)(ISORIGHT));ok
      ((and(> vpang4 110)(< vpang4 250))(ISORIGHT));ok
       ((> vpang4 290)(ISORIGHT));ok
  )
))

 ;;///// 270 degree logic
   (if (and (<= ang 300.00)(> ang 240.00))
     (progn
       (setq vpang5 (rtd (angle p1 p2)))
       (setq isoang 270.00)
       (setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)
   
(cond
  ((AND(> vpang5 270)(< vpang5 360))(ISOLEFT));ok
   ((AND(> vpang5 90)(< vpang5 180))(ISOLEFT)) ;ok
    (if(= isoang 270.00)(isoright));ok
  )))



  ;;///// 330 degree logic
   (if (and (<= ang 360.00)(> ang 300.00))
     (progn
       (setq vpang6 (rtd (angle p1 p2)))
       (setq isoang 330.00)
       (setvar "cmdecho" 0)
   (command "dim" "obl" "l" "" isoang  "exit") 
   (setvar "cmdecho" cmde)
       

 
  (cond
  ((and(> vpang6 70)(< vpang6 110))(ISORIGHT));OK
   ((and(> vpang6 250)(< vpang6 290))(ISORIGHT));ok
    ((and(> vpang6 110.00)(< vpang6 250.00))(ISOLEFT));ok
     ((< vpang6 70)(ISOLEFT));ok
      ((and(> vpang6 110)(< vpang6 250))(ISOLEFT));ok
       ((> vpang6 290)(ISOLEFT));ok
 
  )
))


;reset values if progn runs to completion    
(X=0)
 
  (setq work (x))
  (setq SlopeRound (X))
  (setq ROang (X))
  (setq isoang (x))
  (setq vpang1 (X))
  (setq vpang2 (X))
  (setq vpang3 (X))
  (setq vpang4 (X))
  (setq vpang5 (X))
  (setq vpang6 (X))
 
   (setvar "snapstyl" snpstl)
   (setvar "orthomode" ortho)   
   (princ)



);end defun

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1454
  • Marco
Re: Isometric Dimension lisp... help improve?
« Reply #1 on: May 17, 2013, 03:07:24 AM »
This is a program I wrote almost 20 years ago, it needs other functions to run (now I have no time to prepare everything). To understand the type of dimension I use a "*** image" menu (see file JPG), I think it's quite complex to use grread for previewing the dimension.
Code: [Select]
; Quotatura automatica: orizzontale, verticale, allineata, isometrica. **** 22/12/94
(defun C:Q_ALIGN ( / PatNam pt1 pt2 pt3 pt4 ang2 count prmpt snpstl CurDst DwgScl)
;...
      (setvar "ORTHOMODE" 1)
      (setq
        DwgScl (cond ((ALE_XData_DwgVar_GetBySpace "DWGSCALE")) (1.0))
        pt1    (upoint 40 "" "First reference point" nil nil)
        prmpt  "Next reference point"
        snpstl (getvar "SNAPSTYL")    CurDst (getvar "DIMSTYLE")
        pt3 pt1    pt4 pt1    ang2 nil    count 0
      )
      (if (zerop snpstl)
        (setq #ang (- (uangle 40 "" "Extension lines angle" (+ #ang (gar 90.0)) pt1) (gar 90.0)))
        (progn
          (or
            (tblsearch "BLOCK" "$Iso_Dim_Sty")
            (progn
              (setq PatNam (strcat PatNam "Symbols\\$Iso_Dim_Sty"))
              (command "_.INSERT" (strcat "$Iso_Dim_Sty=" PatNam)) (command)
              (ALE_ReSetUp "" DwgScl DwgScl 1 nil 0)
            )
          )
          (cond
            ( (= #mdiso "spsx")
              (setvar "SNAPISOPAIR" 2) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar  30.0) ang2 (gar  90.0))
            )
            ( (= #mdiso "spdx")
              (setvar "SNAPISOPAIR" 0) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar 330.0) ang2 (gar  90.0))
            )
            ( (= #mdiso "insx")
              (setvar "SNAPISOPAIR" 0) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar 150.0) ang2 (gar  90.0))
            )
            ( (= #mdiso "indx")
              (setvar "SNAPISOPAIR" 2) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar 210.0) ang2 (gar  90.0))
            )
            ( (= #mdiso "avsx")
              (setvar "SNAPISOPAIR" 2) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar  90.0) ang2 (gar  30.0))
            )
            ( (= #mdiso "avdx")
              (setvar "SNAPISOPAIR" 0) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar 270.0) ang2 (gar 150.0))
            )
            ( (= #mdiso "pvsx")
              (setvar "SNAPISOPAIR" 2) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar  90.0) ang2 (gar 150.0))
            )
            ( (= #mdiso "pvdx")
              (setvar "SNAPISOPAIR" 0) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar 270.0) ang2 (gar  30.0))
            )
            ( (= #mdiso "aosx")
              (setvar "SNAPISOPAIR" 1) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar 150.0) ang2 (gar  30.0))
            )
            ( (= #mdiso "aodx")
              (setvar "SNAPISOPAIR" 1) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar 210.0) ang2 (gar 150.0))
            )
            ( (= #mdiso "posx")
              (setvar "SNAPISOPAIR" 1) (setvar "TEXTSTYLE" "$ISO_DX")
              (ALE_FINDDS "ISO_DX")   (setq #ang (gar  30.0) ang2 (gar 150.0))
            )
            ( (= #mdiso "podx")
              (setvar "SNAPISOPAIR" 1) (setvar "TEXTSTYLE" "$ISO_SX")
              (ALE_FINDDS "ISO_SX")   (setq #ang (gar 330.0) ang2 (gar  30.0))
            )
            (T (MYERROR "--->  Modo di quotatura isometrica non specificato") (quit))
          );cond
        )
      );if zerop
      (setq
;|e|;   #mdist (udist 46 "" "Dimension line distance" #mdist pt1)
        pt2    (polar pt1 (+ #ang (gar 90.0)) #mdist)
      )
      (setvar "ORTHOMODE" 0)
      (command) (command "_.DIM")
      (while (setq pt3 (upoint 40 "" prmpt nil pt3))
        (command "_ROTATED" (angtoc #ang) "_NONE" pt1 "_NONE" pt3 "_NONE" pt2 "")
        (or (zerop snpstl) (command "_OBLIQUE" "_LAST" "" (angtoc ang2)))
;|e|;   (setq pt1 pt3    count (1+ count)  prmpt (strcat "<" (itoa (1+ count)) "° Point>/Return to quit"))
        (and (= count 1) (setvar "DIMSE1" 1))
      );while
      (if (> count 1)
        (if
;|e|;     (= "Yes" (setq #si_no (ukword 0 "Yes No" "Total dimension? Y/N" #si_no)))
          (progn
            (setvar "DIMSE1" 0)
            (command
              "_ROTATED" (angtoc #ang) "_NONE" pt4 "_NONE" pt1 (polar pt2 (+ #ang (gar 90.0))
                         (* (getvar "DIMSCALE") (getvar "DIMDLI"))) ""
            )
            (or (zerop snpstl) (command "_OBLIQUE" "_LAST" "" (angtoc ang2)))
          );progn
        )
      );if count
      (command "_RESTORE" CurDst "_EXIT")
 ;...
  (princ)
)
(princ)








CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Isometric Dimension lisp... help improve?
« Reply #2 on: May 17, 2013, 07:36:07 AM »
Looks like a good one Marco.
More ISO fun http://www.theswamp.org/index.php?topic=37429.0
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.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1454
  • Marco
Re: Isometric Dimension lisp... help improve?
« Reply #3 on: May 17, 2013, 09:17:20 AM »
Looks like a good one Marco.
Thanks
More ISO fun http://www.theswamp.org/index.php?topic=37429.0
I have several ISO functions (I start to draw isometrics in 1990),
with Isopro you can go to figure A to B or B to A depend your SNAPSTYL ON or OFF:
Code: [Select]
; C:ALE_ISOPRO - Copyright ©1994 - Marc'Antonio Alessi, Italy - All rights reserved
; http://xoomer.virgilio.it/alessi
(defun C:ALE_ISOPRO ( / SelSet pt1 isopln snpstl CurExp CurSnS)
;  (MODESET '("EXPERT" "OSMODE" "SNAPSTYL"))
  (setq
    CurExp (getvar "EXPERT")  CurSnS (getvar "SNAPSTYL")
    #saxmn (sqrt 0.5)         #saxmg (sqrt 1.5)   
  )
  (if (zerop (getvar "SNAPSTYL")) (setq snpstl T)) ; T se iso è disattivato
  (setvar "EXPERT" 3) (setvar "SNAPSTYL" 1)
;|e|; (prompt "\nSelect object(s) to project: ")
  (if (setq SelSet (ssget))
    (progn
;|e|; (prompt "\nActivate the isometric plane on what to compute the projection and ")
      (setq
;|e|;   pt1 (Ale_uPoint 40 "" "pick reference point <Lastpoint>" (getvar "LASTPOINT") nil)
        isopln (getvar "SNAPISOPAIR")
      )
      (if snpstl ; se lo stile iso è disattivato
        (progn
          (cond
            ( (= 0 isopln) (command "_.ROTATE" SelSet "" "_NONE" pt1 "60.0"))
            ( (= 2 isopln) (command "_.ROTATE" SelSet "" "_NONE" pt1 "300.0"))
          )
          (command
            "_.BLOCK" "$$ISO_TRANS" "_NONE" pt1 SelSet ""
            "_.INSERT" "$$ISO_TRANS" "_NONE" pt1 "X"
            (* #saxmn (/ 1.0 (cos (gar 30.0))))
            (* #saxmg (/ 1.0 (cos (gar 30.0)))) "1.0"
          )
          (if (= 2 isopln) (command  "45.0") (command  "315.0"))
        )
        (progn
          (if (= 2 isopln)
            (command "_.ROTATE" SelSet "" "_NONE" pt1 "135.0")
            (command "_.ROTATE" SelSet "" "_NONE" pt1 "45.0")
          )
          (command
            "_.BLOCK" "$$ISO_TRANS" "_NONE" pt1 SelSet ""
            "_.INSERT" "$$ISO_TRANS" "_NONE" pt1 "X" #saxmg #saxmn "1.0"
          )
          (cond
            ( (= 0 isopln) (command  "300.0"))
            ( (= 1 isopln) (command  "0.0"))
            ( (= 2 isopln) (command  "240.0"))
          )
        );progn else
      );if
      (command "_.EXPLODE" (entlast))
    );progn
;|e|; (alert "Nothing selected, function cancelled. ")
  );if SelSet
; (MODERESET)
  (setvar "EXPERT" CurExp) (setvar "SNAPSTYL" CurSnS)
  (princ)
)
; ---------- Source files from: --------------------------------------------
; These functions are freeware courtesy of the author's of "Inside AutoLisp"
; for rel. 10 published by New Riders Publications. This credit must
; accompany all copies of this function.
; Modified by Alessi Marc'Antonio

(defun Ale_uPoint (IGtBit KwdStr PrmStr DefPnt BasPtn / InpVal DefStr ZetPnt)
  (if DefPnt
    (setq
      ZetPnt (caddr DefPnt)
      DefStr
        (strcat
          (rtos (car  DefPnt)) ","
          (rtos (cadr DefPnt)) ","
          (if ZetPnt (rtos ZetPnt) "0")
        )
      PrmStr (strcat "\n" PrmStr " <" DefStr ">: ")
      IGtBit (logand IGtBit 254)
    )
    (setq PrmStr (strcat "\n" PrmStr ": "))
  )
  (setq InpVal "STRINGANONVALIDA" IGtBit (+ IGtBit 128))
  (while
    (not
      (or
        (= 'LIST (type InpVal))
        (null InpVal)
        (if (= 'STR (type InpVal))
          (or
            (= 'LIST (type (read InpVal)))
            (wcmatch KwdStr (strcat "*" InpVal "*"))
          )
        )
      )
    )
    (initget IGtBit KwdStr)
    (setq InpVal (if BasPtn (getpoint BasPtn PrmStr) (getpoint PrmStr)))
  )
  (if InpVal
    (if (or (/= 'STR (type InpVal)) (atom (read InpVal)))
      InpVal
      (eval
        (if (= "ACTIVE" (cadr (read InpVal)))
          (subst nil "ACTIVE" (read InpVal))
          (read InpVal)
        )
      )
    )
    DefPnt
  )
)

Russelltimk

  • Guest
Re: Isometric Dimension lisp... help improve?
« Reply #4 on: May 17, 2013, 07:47:24 PM »
Quote
To understand the type of dimension I use a "*** image" menu (see file JPG), I think it's quite complex to use grread for previewing the dimension.

Thanks. Yeah, I think I'm going to play around with having it drag an iso rectangle based on my first 2 pick points, and then have the isoplane of the rectangle determined by grread of cursor before thrid point click, for preview purposes.

A bit over my head, but seems doable. Trying to not use any menus to determine look of dimension, just clicking. It functions how I want it to right now, just want to add some sort of "preview".