Topic: Dimension Manager lisp

[mhupp]

oops posted the wrong thing.

Code: [Select]

(if (eq (getvar 'dimstyle) "TOPO")
  (setvar "celtscale" (* scl 0.00025))
  (setvar "celtscale" 1)
)

[PM]

Thanks mhupp 

[PM]

I use this code to change the scale of the dimensions.

I want to add an update to this code and if the dimension style have the name TOPO to change the linetype scale to "celtscale" (* scl 0.00025) unless  the "celtscale" 1. I try to add

Code - Auto/Visual Lisp: [Select]

1. (if (eq (getvar 'dimstyle) "TOPO")
2.   (setvar "celtscale" (* scl 0.00025))
3.   (setvar "celtscale" 1)
4. )

in the code but is not change the linetype scale. Can any one help me?

Thanks

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun c:dimfixscl (/ scl th ars tof ss)  ;was missing scl, n nolonger needed
3.   (vl-load-com) ;needed for vla or vlax functions
4.   (initget 7)
5.   (setq scl (getint "\n Select Scale (50,100,200,250,500,etc) :"))
6.   (setq th (* scl 0.00175))
7.   (setq ars (* scl 0.002))
8.   (setq tof (* scl 0.001))
9. )
10.   (if (and (setq ss (ssget '((0 . "DIMENSION")))) (> scl 0)) ;checks if you inputted a number greater than 0 for scale
11.     (foreach dim (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
12.       (vla-put-TextHeight (vlax-ename->vla-object dim) th)
13.       (vlax-put-property (vlax-ename->vla-object dim) 'ArrowheadSize ars)
14.       (vla-put-TextGap (vlax-ename->vla-object dim) tof)
15.     )  ; foreach
16.   )    ; if
17. )      ; defun
18.  
19.  

[mhupp]

This should get it working.

Code - Auto/Visual Lisp: [Select]

1. (defun c:dimfixscl (/ scl th ars tof ss)  ;was missing scl, n nolonger needed
2.   (vl-load-com)  ;needed for vla or vlax functions
3.   (initget 7)
4.   (setq scl (getint "\n Select Scale (50,100,200,250,500,etc) :")
5.         th (* scl 0.00175) ars (* scl 0.002) tof (* scl 0.001)
6.   )
7.   (if (setq ss (ssget '((0 . "DIMENSION"))))
8.     (foreach dim (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
9.       (setq dim (vlax-ename->vla-object dim))
10.       (vla-put-TextHeight dim th)
11.       (vlax-put-property dim 'ArrowheadSize ars)
12.       (vla-put-TextGap dim tof)
13.       (if (= (vlax-get-property dim 'StyleName) "TOPO")
14.         (vla-put-linetypescale dim (* scl 0.00025))
15.         (vla-put-linetypescale dim 1)
16.       )
17.     )
18.   )
19.   (princ)
20. )

[PM]

Hi mhupp . I try your code but not change the linetype scale.
 Lookk the dwg file with the dimension styles and the test i did.

Thanks

[mhupp]

Sorry I didn't understand what you wanted. The code is updated and will do what you want now.

[PM]

Thanks mhupp   now works fine