Jump to content

Help with dimension lisp code

Guest

By Guest
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Guest

Guest

Posted
Posted

I am trying to do some changes ton an old dimension lisp code. Tis code select a polyline and insert dimension text detween vertex of polyline (open/ close)

 

I want to add option menu for layer and font style. The problem is that when i choose option 1  use the font style for the option 1 but insert the text in option 2 layer. I dont know why. Can any one help me?

  

(Defun C:TEST1 (/ txtstl txtsze stryn prfx sufx svr scl ht pt pti ptx pty
                   old oldpl nodpl ptyp pllst i n prin meta distmeta ptdist
                   angprin angmeta angtxt ptp alfa nlin xlin ylin dlin flg 
                   xreg yreg na xa ya)





;*************drawing set-up***************************

   (command "undo" "m")
   (setvar "unitmode" 0)
   (setvar "aunits" 2)
   (setvar "angbase" (/ pi 2))
   (setvar "angdir" 1)
   (setvar "auprec" 4)
   (setvar "lunits" 2)
   (setvar "luprec" 3)
   (setvar "dimzin" 0)
(setq svr(getvar "osmode"))
(setq txtstl(getvar "textstyle"))
(setq txtsze(getvar "textsize"))
(setvar "cmdecho" 0)
(setq flg 1)
(setvar "cmdecho" 0)
 (setq scl (getvar "useri1")) ; dont change this
 (setq ht(* 0.00175 scl))     ; dont change this

;------------------------------------------------------------

  (TEXTPAGE)

 (princ "\n")(princ "\n")(princ "\n")
(progn
	   (initget "1 2")
	   (setq
	     l
	      (cond
		((getkword
		   "\n select:
	               1. option1. 
	               2. option2.
"
		 )
		)
		("1")
	      )
	   )

(if (eq l "1")
      (command "-style" "diast" "wgsimpl.shx" "0" "1.2" "0" "N" "N" "N")
      (command "_layer" "_m" "dim" "_c" "93" "" "_lw" "0.30" "" "")
          )
       (if (eq l "2")
      (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
      (command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "")
           )
       
)

;--------------------------------------------------------------------------------------------

:********BOUNDARY LINE**********

 (setvar "osmode" 0)
 (setq old(entsel "\n select lwpolyline: "))
 (setq oldpl(entget(car old)))
 (setq nodpl(cdr(assoc 90 oldpl)))
 (setq ptyp (cdr(assoc 70 oldpl)))
 (command "area" "e" old)
 (setq pllst '())
 (setq i 0)
 (setq n 0)
 (while (car(nth i oldpl))
        (if (= (car(nth i oldpl)) 10) 
               (progn
                     (setq pllst (append pllst (list (cdr(nth i oldpl)))))
                     (setq n(+ 1 n))
               );endprogn
        );endif
         (setq i (+ i 1))
 );endwhile
 (if (= ptyp 1)
   (progn
         (setq pllst (append pllst (list(nth 0 pllst))))
         (setq pllst (cdr pllst))
   );endprogn     
 );endif
; (main)
;);close defun
;(defun main()

;*******
 (setq alfa 193)
 (foreach n pllst (command n))
 (command "")
 (command "erase" pt "")
 (setq i 0 prin 0 meta 0)
 (while (car(nth i pllst))
  (setq prin (- i 1))
  (setq meta (+ i 1))
    (if (= i 0)
               (setq prin (- n 1))
    )
    (if (= i (- n 1))
               (setq meta 0)
    )
  (setq angprin (angle (nth i pllst) (nth prin pllst)))
  (setq angmeta (angle (nth i pllst) (nth meta pllst)))
  (setq distmeta (distance (nth i pllst) (nth meta pllst)))

;-------------------------------------------------------------------------------

  (setq ptdist (polar 
                     (polar (nth i pllst) angmeta (/ distmeta 2)) 
                     (+ angmeta (* (/ pi 2) flg)) (* 0.5 ht)))
  (setq angtxt(- 500 (/ (* 400 angmeta) (* 2 pi)))) 
  (if (> angtxt 400)
              (setq angtxt (- angtxt 400))
  )
  (if (> angtxt 200)
        (progn
              (setq ptdist (polar 
                                 (polar (nth i pllst) angmeta (/ distmeta 2)) 
                                 (+ angmeta (* (/ pi 2) flg)) (* 1.50 ht)))
              (setq angtxt (- angtxt 200))
        );endprogn
  )
  (command "text" "j" "c" 
                         ptdist ht 
                         angtxt
                         (rtos distmeta 2 2)
  )
    (setq i (+ i 1))
 );endwhile
 (if (= ptyp 0)
               (command "erase" "l" "")
 )

 (setvar "osmode" svr)
 (setvar "cmdecho" 1)
 (setvar "textstyle" txtstl)
 (setvar "textsize"  txtsze)

; layer 0

(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
 (princ)
);close defun

 

Thanks

mhupp Grand Master

mhupp

Posted
Posted (edited)

The if statements after picking the options will only run the first line if true or 2nd line if false.  if you want to run multiple lines of code after an if statement you have to use (progn

  

(if statement
  (progn
    (line 1)
    (line 2)
    ...
  ) ;end progn
);end if

 

 

when you pick option 1

(command "-style" "diast" "wgsimpl.shx" "0" "1.2" "0" "N" "N" "N") ;true

(command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "") ;false

 

when you pick option 2

(command "_layer" "_m" "dim" "_c" "93" "" "_lw" "0.30" "" "") ;false

(command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N") ;true

 

 

This uses cond after the option they don't need progn to run multiple lines of code. also they stop and don't check the other conditional statements if one is found to be true.

also uses visual lisp to calculate the text. 

(Defun C:TEST1 (/ txtstl txtsze stryn prfx sufx svr scl ht pt pti ptx pty
                  old oldpl nodpl ptyp pllst i n prin meta distmeta ptdist
                  angprin angmeta angtxt ptp alfa nlin xlin ylin dlin flg
                  xreg yreg na xa ya
               )
  ;*************drawing set-up***************************
  (command "undo" "m")
  (setvar 'unitmode 0)
  (setvar 'aunits 2)
  (setvar 'angbase (/ pi 2))
  (setvar 'angdir 1)
  (setvar 'auprec 4)
  (setvar 'lunits 2)
  (setvar 'luprec 3)
  (setvar 'dimzin 0)
  (setq svr (getvar "osmode"))
  (setq txtstl (getvar "textstyle"))
  (setq txtsze (getvar "textsize"))
  (setvar "cmdecho" 0)
  (setq flg 1)
  (setvar "cmdecho" 0)
  (setq scl (getvar "useri1"))  ; dont change this
  (setq ht (* 0.00175 scl))     ; dont change this
  ;------------------------------------------------------------
  (TEXTPAGE)
  (princ "\n\n\n")
  ;(princ "\n") (princ "\n") (princ "\n")
  (initget "1 2")
  (setq opt
    (cond
      ((getkword "\n Select: Option[1] or Option2: ")) ("1")
    )
  )
  (cond
    ((= opt "1") ;will run both lines of code
      (command "-style" "diast" "wgsimpl.shx" "0" "1.2" "0" "N" "N" "N")
      (command "_layer" "_m" "dim" "_c" "93" "" "_lw" "0.30" "" "")
    )
    ((= opt "2") ;will run both lines of code
      (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
      (command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "")
    )
  )      
  (setvar 'osmode 0)
  (setq poly (vlax-invoke (vlax-ename->vla-object (car (entsel "\nSelect lwpolyline:"))) 'explode)) ;makes a copy of the polyline and explodes it
  (foreach obj poly ;processes each entity in poly list                                             ;adding all sub entitys into a list named poly
    (cond
      ((eq (vla-get-Objectname obj) "AcDbArc")
        (setq len (vla-get-arclength obj))
        (setq p1 (vlax-get obj 'StartPoint))
        (setq p2 (vlax-curve-getPointAtDist obj (/ len 2)))
        (setq p3 (vlax-get obj 'EndPoint))
        (setq ang (angle p1 p3))
        (entmakex (list (cons 0 "TEXT")
                        (cons 10  p2)
                        (cons 11  p2)
                        (cons 40 txtsze)
                        (cons 50 ang)
                       '(71 . 0)
                       '(72 . 1)
                       '(73 . 2)
                        (cons 1  (rtos len 2 2))
                  )
        )
        (vla-delete obj)
      )
      ((eq (vla-get-Objectname obj) "AcDbLine")
        (setq len (vla-get-length obj))
        (setq p1 (vlax-get obj 'StartPoint))
        (setq p2 (vlax-curve-getPointAtDist obj (/ len 2)))
        (setq p3 (vlax-get obj 'EndPoint))
        (setq ang (angle p1 p3))
        (entmakex (list (cons 0 "TEXT")
                        (cons 10  p2)
                        (cons 11  p2)
                        (cons 40 txtsze)
                        (cons 50 ang)
                       '(71 . 0)
                       '(72 . 1)
                       '(73 . 2)
                        (cons 1  (rtos len 2 2))
                  )
        )        
        (vla-delete obj)
      )
    )
  )
  (setvar "osmode" svr)
  (setvar "cmdecho" 1)
  (setvar "textstyle" txtstl)
  (setvar "textsize" txtsze)
  (setvar "textstyle" txtstl)
  (mapcar 'setvar '( "clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
  (princ)
)

 

Edited by mhupp
Guest

Guest

Posted
Posted

Hi mhupp. Thanks for the replay.I try your code but is not run both lines of code. Create the text styles but use as text style the STANDARD.

Any ideas?

mhupp Grand Master

mhupp

Posted
Posted

it errors for me when wgsimpl.shx is called. since i don't have that font I commented it out when i was checking my code.

 

make sure that font is loaded?

 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...