Author Topic: Application for tolerances, need comments  (Read 2843 times)

0 Members and 1 Guest are viewing this topic.

roblau

  • Mosquito
  • Posts: 5
Application for tolerances, need comments
« on: July 25, 2010, 12:33:18 PM »
I am new in theSwamp
Please, help to improve this program

Code: [Select]
(defun c:stol () (c:settolerancia))
(defun c:settolerancia ()
    (vl-load-com)
    (setq beent nil)
    (setq sset (ssget "_P" '((0 . "DIMENSION"))))
    (if sset
(if (/= (sslength sset) 0)
    (progn (setq be2ent (ssname sset 0)) (setq beent 1))
    (setq sset nil)
    ) ;_ end of if
) ;_ end of if
    (while (not beent)
(setq beent (entsel "\nSelect dimension: "))
(if (and beent
(= (cdr (assoc 0 (entget (car beent)))) "DIMENSION")
) ;_ end of and
    (setq be2ent (entget (car beent)))
    (progn (alert "\nThis is not a Dimension or Selection is Null...")
   (setq beent nil)
   ) ;_ end of progn
    ) ;_ end of if
) ;_ end of while
    (setq vlaobject-beent (vlax-ename->vla-object be2ent))
    (vlax-put-property vlaobject-beent "Layer" "dimensoes")
    (setq mednominal
     (rtos (vlax-get-property vlaobject-beent "measurement") 2 3)
  ) ;_ end of setq
    (setq flagmed (vl-string-position 46 mednominal))
    (if (= flagmed nil)
(setq mednominal (strcat mednominal ".00"))
) ;_ end of if
    (if (/= flagmed nil)
(progn (setq ponto (+ 2 (vl-string-position 46 mednominal)))
       (setq framednom (substr mednominal ponto))
       (setq tamanho (strlen framednom))
       (if (= 1 tamanho)
   (setq mednominal (strcat mednominal "0"))
   ) ;_ end of if
       ) ;_ end of progn
) ;_ end of if
    (setq upper (rtos
    (vlax-get-property vlaobject-beent "ToleranceUpperLimit")
    ) ;_ end of rtos
  ) ;_ end of setq
    (setq lower (rtos
    (vlax-get-property vlaobject-beent "ToleranceLowerLimit")
    ) ;_ end of rtos
  ) ;_ end of setq
    (setq valores+ '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
    (setq valores- '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
    (setq prefixo nil)
    (setq dcl_id (load_dialog "settolerance.dcl"))
    (if (not (new_dialog "settolerance" dcl_id))
(exit)
) ;_ end of if
    (start_list "selections+")
    (mapcar 'add_list valores+)
    (end_list)
    (start_list "selections-")
    (mapcar 'add_list valores-)
    (end_list)
    (set_tile "benomed" mednominal) ;(set_tile "selections+" "1")
    (action_tile "tg01" "(setq Prefixo \"Nul\")")
    (action_tile "tg02" "(setq Prefixo \"Raio\")")
    (action_tile "tg03" "(setq Prefixo \"Dia\")")
    (action_tile "tg04" "(setq Prefixo \"Square\")")
    (action_tile "cancel" "(done_dialog) (setq userclick nil)")
    (action_tile
"accept"
(strcat
    "(progn (setq val+ (atof (get_tile \"selections+\")))
            (setq val- (atof (get_tile \"selections-\")))
            ( done_dialog) (setq userclick T))"
    ) ;_ end of strcat
) ;_ end of action_tile
    (start_dialog)
    (unload_dialog dcl_id)
    (progn (setq siz+ (fix val+))
   (setq val+ (atof (nth siz+ valores+)))
   ) ;_ end of progn
    (progn (setq siz- (fix val-))
   (setq val- (atof (nth siz- valores-)))
   ) ;_ end of progn
    (if (= siz+ 0)
(setq flag+ 0)
(progn (if (> siz+ 5)
   (setq flag+ 1)
   (setq flag+ 2)
   ) ;_ end of if
       ) ;_ end of progn
) ;_ end of if
    (if (= siz- 0)
(setq flag- 0)
(progn (if (> siz- 5)
   (setq flag- 1)
   (setq flag- 2)
   ) ;_ end of if
       ) ;_ end of progn
) ;_ end of if
    (if (> flag+ flag-)
(setq flagf flag+)
(setq flagf flag-)
) ;_ end of if
    (if userclick
(progn
    (if (/= prefixo nil)
(progn
    (if (= prefixo "Nul")
(vlax-put-property vlaobject-beent "TextPrefix" "")
) ;_ end of if
    (if (= prefixo "Raio")
(vlax-put-property vlaobject-beent "TextPrefix" "R ")
) ;_ end of if
    (if (= prefixo "Dia")
(vlax-put-property vlaobject-beent "TextPrefix" "%%c")
) ;_ end of if
    (if (= prefixo "Square")
(vlax-put-property
    vlaobject-beent
    "TextPrefix"
    "Square "
    ) ;_ end of vlax-put-property
) ;_ end of if
    ) ;_ end of progn
) ;_ end of if
    (if (= flagf 2)
(progn
    (vlax-put-property
vlaobject-beent
"SuppressTrailingZeros"
0
) ;_ end of vlax-put-property
    (vlax-put-property vlaobject-beent "SuppressLeadingZeros" 1)
    (vlax-put-property
vlaobject-beent
"PrimaryUnitsPrecision"
2
) ;_ end of vlax-put-property
    (vlax-put-property vlaobject-beent "tolerancedisplay" 2)
    (vlax-put-property vlaobject-beent "TolerancePrecision" 2)
    (vlax-put-property
vlaobject-beent
"ToleranceHeightScale"
0.7
) ;_ end of vlax-put-property
    (vlax-put-property
vlaobject-beent
"ToleranceUpperLimit"
val+
) ;_ end of vlax-put-property
    (vlax-put-property
vlaobject-beent
"ToleranceLowerLimit"
val-
) ;_ end of vlax-put-property
    ) ;_ end of progn
) ;_ end of if
    (if (= flagf 1)
(progn
    (vlax-put-property
vlaobject-beent
"SuppressTrailingZeros"
0
) ;_ end of vlax-put-property
    (vlax-put-property vlaobject-beent "SuppressLeadingZeros" 1)
    (vlax-put-property
vlaobject-beent
"PrimaryUnitsPrecision"
1
) ;_ end of vlax-put-property
    (vlax-put-property vlaobject-beent "tolerancedisplay" 2)
    (vlax-put-property vlaobject-beent "TolerancePrecision" 1)
    (vlax-put-property
vlaobject-beent
"ToleranceUpperLimit"
val+
) ;_ end of vlax-put-property
    (vlax-put-property
vlaobject-beent
"ToleranceLowerLimit"
val-
) ;_ end of vlax-put-property
    (vlax-put-property
vlaobject-beent
"ToleranceHeightScale"
0.7
) ;_ end of vlax-put-property
    ) ;_ end of progn
) ;_ end of if
    ) ;end progn
) ;_ end of if
    (princ)
    ) ;_ end of defun

And DCL

Code: [Select]
Settolerance:
dialog {
         label = "Designar Tolerâncias" ;
         :row{
         : boxed_radio_column {
                       label = "Prefix";
                       alignment = centered ;

                       : radio_button {
                                label = "Nothing";
                                key = "tg01";
                                      }
                       : radio_button {
                                label = "Radius";
                                key = "tg02";
                                      }
                       : radio_button {
                                label = "Diameter";
                                key = "tg03";
                                      }
                       : radio_button {
                                label = "Square";
                                key = "tg04";
                                }
                      }



         :boxed_column{
                            label = "Measure Nominal" ;
                            :row{
                                fixed_width = true;
                                alignment = centered ;
                            :text{
                                  alignment = centered ;
                                  width = 8 ;
                                   fixed_width = true;
                                  is_bold = true;
                                  key = "benomed" ;
                                 }
                            }
                            }
       :boxed_column{
                    label = "Deviation" ;
                    :row{
                         :edit_box{
                                    label = "Upper Deviation =>";
                                    key = "DclUpper";
                            }
                                 
                         :popup_list{
                                    key = "selections+" ;
                                    value = "0" ;
                                    }
                        }
                    :row{
                         :edit_box{
                                    label = "Lower Deviation =>";
                                    key = "DclLower";
                            }                          
                         :popup_list{
                                    key = "selections-" ;
                                    value = "0" ;
                                     }
                        }
                    }
         }               
ok_cancel ;

}

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Application for tolerances, need comments
« Reply #1 on: July 25, 2010, 01:15:41 PM »
First thing ... localize variables  :-):

Code: [Select]
(defun c:settolerancia (/    be2ent     beent dcl_id     flag+
flag-    flagf      flagmed framednom  lower
mednominal ponto      prefixo siz+     siz-
sset    tamanho    upper userclick  val+
val-    valores+   valores- vlaobject-beent
       )

Welcome to the swamp.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

roblau

  • Mosquito
  • Posts: 5
Re: Application for tolerances, need comments
« Reply #2 on: July 26, 2010, 08:28:15 PM »
Thanks ronjonp

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Application for tolerances, need comments
« Reply #3 on: July 27, 2010, 07:27:13 AM »
I started working on this but don't have time to finish, so if you will debug it.
Here is what I have so far. I may have time on Wednesday to look at it again.
Code: [Select]
(defun c:stol () (c:settolerancia))
(defun c:settolerancia (/ be2ent     beent      dcl_id     flag+      flag-      flagf
                        flagmed    framednom  lower      mednominal ponto      prefixo
                        siz+       siz-       sset       tamanho    upper      userclick
                        val+       val-       valores+   valores-   vlaobject-beent
                        lyrname    color      ltype      DCLfile
                       )

  (vl-load-com)
  (cond
    ((and (setq sset (ssget "_P" '((0 . "DIMENSION"))))
          (setq be2ent (ssname sset 0))
          (= (cdr (assoc 0 (entget be2ent))) "DIMENSION")
          (setq beent be2ent)
          nil
     )
    )

    (t
     (while (not beent)                 ; loop until a dimension is selected
       (setq beent (entsel "\nSelect dimension: "))
       (if (and beent (= (cdr (assoc 0 (entget (car beent)))) "DIMENSION"))
         (setq be2ent (car beent))
         (progn
           (alert "\nThis is not a Dimension or Selection is Null...")
           (setq beent nil)
         ) ;_ end of progn
       ) ;_ end of if
     ) ;_ end of while

     (setq vlaobject-beent (vlax-ename->vla-object be2ent))
     
     ;;  layer creation needed here
     (setq lyrname "dimensoes")
  (if (tblsearch "LAYER" lyrname)
    (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
    (command "._Layer" "_Make" lyrname "_Color"
             (if (or (null color)(= Color "")) "_White" Color) lyrname
             "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
  )
     ;;------------------------------
     
     (vlax-put-property vlaobject-beent "Layer" "dimensoes")
     (setq mednominal (rtos (vlax-get-property vlaobject-beent "measurement") 2 3))

     (if (null (setq flagmed (vl-string-position 46 mednominal)))
       (progn
         (setq mednominal (strcat mednominal ".00"))
         (setq ponto (+ 2 (vl-string-position 46 mednominal)))
         (setq framednom (substr mednominal ponto))
         (setq tamanho (strlen framednom))
         (if (= 1 tamanho)
           (setq mednominal (strcat mednominal "0"))
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (setq upper (rtos (vlax-get-property vlaobject-beent "ToleranceUpperLimit")))
     (setq lower (rtos (vlax-get-property vlaobject-beent "ToleranceLowerLimit")))
     (setq valores+ '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
     (setq valores- '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
     (setq DCLfile (findfile "settolerance.dcl"))
     (setq dcl_id (load_dialog DCLfile))
     (if (new_dialog "settolerance" dcl_id)
       (progn
         (start_list "selections+")
         (mapcar 'add_list valores+)
         (end_list)
         (start_list "selections-")
         (mapcar 'add_list valores-)
         (end_list)
         (set_tile "benomed" mednominal) ;(set_tile "selections+" "1")
         (action_tile "tg01" "(setq Prefixo \"Nul\")")
         (action_tile "tg02" "(setq Prefixo \"Raio\")")
         (action_tile "tg03" "(setq Prefixo \"Dia\")")
         (action_tile "tg04" "(setq Prefixo \"Square\")")
         (action_tile "cancel" "(done_dialog) (setq userclick nil)")
         (action_tile
           "accept"
           (strcat
             "(progn (setq val+ (atof (get_tile \"selections+\")))
            (setq val- (atof (get_tile \"selections-\")))
            ( done_dialog) (setq userclick T))"
           ) ;_ end of strcat
         ) ;_ end of action_tile
         (start_dialog)
         (unload_dialog dcl_id)
         (setq siz+ (fix val+))
         (setq val+ (atof (nth siz+ valores+)))
         (setq siz- (fix val-))
         (setq val- (atof (nth siz- valores-)))
         (cond
           ((zerop siz+) (setq flag+ 0))
           ((> siz+ 5) (setq flag+ 1))
           (t (setq flag+ 2))
         )
         (cond
           ((zerop siz-) (setq flag- 0))
           ((> siz- 5) (setq flag- 1))
           (t (setq flag- 2))
         )
         (setq flagf (max flag+ flag-)
         ) ;_ end of if
         (if userclick
           (progn
             (cond
               ((null prefixo))         ; do nothing
               ((= prefixo "Nul")
                (vlax-put-property vlaobject-beent "TextPrefix" "")
               )
               ((= prefixo "Raio")
                (vlax-put-property vlaobject-beent "TextPrefix" "R ")
               )
               ((= prefixo "Dia")
                (vlax-put-property vlaobject-beent "TextPrefix" "%%c")
               )
               ((= prefixo "Square")
                (vlax-put-property vlaobject-beent "TextPrefix" "Square ")
               )
             ) ;_ end of cond
             (cond
               ((= flagf 2)
                (vlax-put-property vlaobject-beent "SuppressTrailingZeros" 0)
                (vlax-put-property vlaobject-beent "SuppressLeadingZeros" 1)
                (vlax-put-property vlaobject-beent "PrimaryUnitsPrecision" 2)
                (vlax-put-property vlaobject-beent "tolerancedisplay" 2)
                (vlax-put-property vlaobject-beent "TolerancePrecision" 2)
                (vlax-put-property vlaobject-beent "ToleranceHeightScale" 0.7)
                (vlax-put-property vlaobject-beent "ToleranceUpperLimit" val+)
                (vlax-put-property vlaobject-beent "ToleranceLowerLimit" val-)
               )
               ((= flagf 1)
                (vlax-put-property vlaobject-beent "SuppressTrailingZeros" 0)
                (vlax-put-property vlaobject-beent "SuppressLeadingZeros" 1)
                (vlax-put-property vlaobject-beent "PrimaryUnitsPrecision" 1)
                (vlax-put-property vlaobject-beent "tolerancedisplay" 2)
                (vlax-put-property vlaobject-beent "TolerancePrecision" 1)
                (vlax-put-property vlaobject-beent "ToleranceUpperLimit" val+)
                (vlax-put-property vlaobject-beent "ToleranceLowerLimit" val-)
                (vlax-put-property vlaobject-beent "ToleranceHeightScale" 0.7)
               )
             )                          ;end cond
           )
         ) ;_ end of if
       )
     )
    )
  )

  (princ)
) ;_ end of defun

Code: [Select]
dcl_settings : default_dcl_settings { audit_level = 3; }
settolerance :
dialog {label = "Designar Tolerâncias" ;
  :row{
    : boxed_radio_column { label = "Prefix"; alignment = centered ;
      : radio_button { key = "tg01"; label = "Nothing";}
      : radio_button { key = "tg02"; label = "Radius";}
      : radio_button { key = "tg03"; label = "Diameter";}
      : radio_button { key = "tg04"; label = "Square";}
    }
    :boxed_column{ label = "Measure Nominal" ;
      :row{ fixed_width = true; alignment = centered ;
        :text{ key = "benomed" ; fixed_width = true; alignment = centered ; width = 8 ; is_bold = true;}
      }
    }
    :boxed_column{ label = "Deviation" ;
      :row{
:edit_box{ key = "DclUpper"; label = "Upper Deviation =>";}
:popup_list{ key = "selections+" ; value = "0" ;}
      }
      :row{
:edit_box{ key = "DclLower"; label = "Lower Deviation =>";}                          
:popup_list{ key = "selections-" ; value = "0" ; }
      }
    }
  }               
  ok_cancel ;
}


<edit: code & DCL updated>
« Last Edit: July 30, 2010, 06:13:56 PM by CAB »
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.

roblau

  • Mosquito
  • Posts: 5
Re: Application for tolerances, need comments
« Reply #4 on: July 30, 2010, 05:14:27 PM »
Thanks Cab. Your code is very compact, but the first cond don't work for me.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Application for tolerances, need comments
« Reply #5 on: July 30, 2010, 06:15:42 PM »
I just replaced the lisp code AND the DCL code

Just tested it for the first time and think it's working.
No test on the previous selection code though.
I'll leave that for you. 8-)
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.

roblau

  • Mosquito
  • Posts: 5
Re: Application for tolerances, need comments
« Reply #6 on: July 30, 2010, 07:48:22 PM »
Cab, in dcl the edit box don't have input for the variable "val" because the key DclUpper and DclLower don't  appears in the action_tile "accept".
I like the idea, but how I can do it's work? (sorry for my bad English)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Application for tolerances, need comments
« Reply #7 on: July 30, 2010, 09:11:09 PM »
Just add them in.
Code: [Select]
         (action_tile
           "accept"
           (strcat
             "(progn (setq val+ (atof (get_tile \"selections+\")))
            (setq val- (atof (get_tile \"selections-\")))
            (setq UpperD (atof (get_tile \"DclUpper\")))
            (setq LowerD (atof (get_tile \"DclLower\")))
            ( done_dialog) (setq userclick T))"
           ) ;_ end of strcat
         ) ;_ end of action_tile
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.

roblau

  • Mosquito
  • Posts: 5
Re: Application for tolerances, need comments
« Reply #8 on: July 31, 2010, 08:21:51 PM »
Hello Cab, thank's for your help. I implemented your code and other functions.I need your comments.Thank's

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Application for tolerances, need comments
« Reply #9 on: August 02, 2010, 08:53:46 PM »
Here is a quick revision:
Code: [Select]
(defun c:stol2 () (c:settolerancia2))
(defun c:settolerancia2 (/          sset       be2ent     beent      vlaobject-beent
                         mednominal flagmed    ponto      framednom  tamanho
                         upper      lower      valores+   valores-   index+
                         index-     dcl_id     siz+       siz-       upperd
                         lowerd     temppos+   temppos-   size+      size-
                         size       prefixo    userclick
                        )
  (vl-load-com)

;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; FUNCTION
;;;   To filter a preselected selection set for object types
;;;   listed in the variable list lst
;;;
;;; ARGUMENTS
;;;   lst -> a list of object types like ("TEXT" "MTEXT")
;;;          nil will allow all types
;;;
;;; USAGE
;;;   (setq ss (getpickfirst typs))
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler 
;;;          Co-author S. Madsen
;;;   ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.1 Sep. 18, 2004
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  (defun getpickfirst (lst / ss a ent)
    ;;  lst is a list of object types like ("TEXT" "MTEXT")
    (cond ((and (setq ss (cadr (ssgetfirst))) ; get previously selected sel set
                lst                     ; nil will allow all types
           )
           (setq a 0)                   ; set pointer
           (repeat (sslength ss)        ; foreach object in sel set
             (setq ent (ssname ss a)    ; get obj name
                   a   (1+ a)
             )                          ; increment counter
             ;; is obj not a member of the list ?
             (and (not (member (cdr (assoc 0 (entget ent))) lst))
                  (ssdel ent ss)        ; if not a member remove it from ss
                  (setq a (1- a))       ; and deincrement pointer
             )                          ; and
           )                            ; repeat
          )                             ; end cons 1
    )                                   ; end cond stmt
    ;; if ss is a pick set and has objects then return the selection set
    (if (and (= (type ss) 'pickset) (/= 0 (sslength ss)))
      ss
    )
    ;;  else return nil because when IF fails it returns nil
  )
  ;; end defun
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  (cond ((and (setq sset (getpickfirst '("DIMENSION")))
              (setq be2ent (ssname sset 0))
              (null (setq sset nil))    ; return T so the WHILE is not executited
         )
        )
        ;;  Nothing pre selected so loop for one user selection
        ((while (not be2ent)            ; loop until a dimension is selected
           (setq beent (entsel "\nSelect dimension: "))
           (if (and beent (= (cdr (assoc 0 (entget (car beent)))) "DIMENSION"))
             (setq be2ent (car beent))
             (progn (alert "\nThis is not a Dimension or Selection is Null...")
                    (setq beent nil)
             )
           )
         )
        )
  )
  (if be2ent
    (progn
      (setq vlaobject-beent (vlax-ename->vla-object be2ent))
      (vlax-put-property vlaobject-beent "Layer" "dimensoes")
      (setq mednominal (rtos (vlax-get-property vlaobject-beent "measurement") 2 3))
      (if (null (setq flagmed (vl-string-position 46 mednominal)))
        (progn (setq mednominal (strcat mednominal ".00"))
               (setq ponto (+ 2 (vl-string-position 46 mednominal)))
               (setq framednom (substr mednominal ponto))
               (setq tamanho (strlen framednom))
               (if (= 1 tamanho)
                 (setq mednominal (strcat mednominal "0"))
               )
        )
      )
      (setq upper (rtos (vlax-get-property vlaobject-beent "ToleranceUpperLimit") 2 2))
      (if (or (= upper "0") (null upper))
        (setq upper "0.00")
      )
      (setq lower (rtos (vlax-get-property vlaobject-beent "ToleranceLowerLimit") 2 2))
      (if (or (= lower "0") (null lower))
        (setq lower "0.00")
      )
      (setq valores+ '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
      (setq valores- '("0.00" "0.01" "0.02" "0.03" "0.04" "0.05" "0.1" "0.2"))
      (setq dcl_id (load_dialog "settolerance2.dcl"))
      (if (new_dialog "Settolerance2" dcl_id)
        (progn
          (set_tile "benomed" mednominal)
          (start_list "selections+")
          (mapcar 'add_list valores+)
          (end_list)
          (if (setq n (vl-position upper valores+))
            (set_tile "selections+" (itoa n))
            (set_tile "selections+" "0")
          )
          (start_list "selections-")
          (mapcar 'add_list valores-)
          (end_list)
          (if (setq n (vl-position lower valores-))
            (set_tile "selections-" (itoa n))
            (set_tile "selections-" "0")
          )
          (action_tile "tg01" "(setq Prefixo \"Nul\")")
          (action_tile "tg02" "(setq Prefixo \"Raio\")")
          (action_tile "tg03" "(setq Prefixo \"Dia\")")
          (action_tile "tg04" "(setq Prefixo \"Square\")")
          (action_tile "cancel" "(done_dialog) (setq userclick nil)")
          (action_tile
            "accept"
            (strcat
              "(progn (setq val+ (atof (get_tile \"selections+\")))
  (setq val- (atof (get_tile \"selections-\")))
  (setq UpperD (atof (get_tile \"DclUpper\")))
  (setq LowerD (atof (get_tile \"DclLower\")))
  ( done_dialog)
  (setq userclick T))"
            )
          )
          (start_dialog)
          (unload_dialog dcl_id)
          (if userclick
            (progn
              (setq siz+ (fix val+))
              (setq val+ (atof (nth siz+ valores+)))
              (setq siz- (fix val-))
              (setq val- (atof (nth siz- valores-)))
              (if (not (and (zerop lowerd) (zerop upperd)))
                (setq val+ upperd
                      val- lowerd
                )
              )
              (setq val+ (rtos val+ 2))
              (setq val- (rtos val- 2))
              (if (/= val+ "0")
                (setq temppos+ (vl-string-search "." val+)
                      size+    (strlen (substr val+ (+ 2 temppos+)))
                )
                (setq size+ 0)
              )
              (if (/= val- "0")
                (setq temppos- (vl-string-search "." val-)
                      size-    (strlen (substr val- (+ 2 temppos-)))
                )
                (setq size- 0)
              )
              (setq size (max size+ size-))
              (setq val+ (atof val+))
              (setq val- (atof val-))
              (cond
                ((null prefixo))        ; do nothing
                ((= prefixo "Nul") (vlax-put-property vlaobject-beent "TextPrefix" ""))
                ((= prefixo "Raio")
                 (vlax-put-property vlaobject-beent "TextPrefix" "R ")
                )
                ((= prefixo "Dia")
                 (vlax-put-property vlaobject-beent "TextPrefix" "%%c")
                )
                ((= prefixo "Square")
                 (vlax-put-property vlaobject-beent "TextPrefix" "Square ")
                )
              )
              (cond ((/= size 0)
                     (vlax-put-property vlaobject-beent "SuppressTrailingZeros" 0)
                     (vlax-put-property vlaobject-beent "SuppressLeadingZeros" 0)
                     (vlax-put-property vlaobject-beent "PrimaryUnitsPrecision" size)
                     (vlax-put-property vlaobject-beent "TolerancePrecision" size)
                     (vlax-put-property vlaobject-beent "ToleranceHeightScale" 0.7)
                     (vlax-put-property vlaobject-beent "ToleranceUpperLimit" val+)
                     (vlax-put-property vlaobject-beent "ToleranceLowerLimit" val-)
                     (vlax-put-property vlaobject-beent "ToleranceDisplay" 2)
                    )
              )                         ;end cond
            )
          )
        )
      )
    )                                   ; progn
  )
  (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.

HasanCAD

  • Swamp Rat
  • Posts: 1422
Re: Application for tolerances, need comments
« Reply #10 on: August 03, 2010, 06:24:56 AM »
There is error
Code: [Select]
Command: ; error: An error has occurred inside the *error* functionAutoCAD
variable setting rejected: "cmdecho" nil

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Application for tolerances, need comments
« Reply #11 on: August 03, 2010, 08:05:27 AM »
You have an error handler active that should not be. Try this at the command line.
(setq *error* nil)
That should disable it and you can see the real error.
My guess is that the LAYER issue may be the problem as you removed the layer creation code I
placed in my first routine. I did not add it back because you removed it.

Make sure the layer "dimensoes" exist in the DWG or it will error.

This is the code that needs to be added:
Code: [Select]
     ;;  layer creation needed here
     (setq lyrname "dimensoes")
  (if (tblsearch "LAYER" lyrname)
    (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
    (command "._Layer" "_Make" lyrname "_Color"
             (if (or (null color)(= Color "")) "_White" Color) lyrname
             "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
  )
     ;;------------------------------
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.