0 Members and 1 Guest are viewing this topic.
(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
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 ;}
(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 )
(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
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 ;}
(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
(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))
Command: ; error: An error has occurred inside the *error* functionAutoCAD variable setting rejected: "cmdecho" nil
;; 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 "") ) ;;------------------------------