Help with dimension lisp

January 10, 2023

Hi , I am using this code for dimension open/close polylines. Sometimes I have to dimension multiple close polylines like the attach file, and for the same side of the polygon have duplicate dimensions (one for each polygon). I need help to update the code

a) Select multiple polylines (not one every time)

b) Don't have duplicate dimensions

;qq.lsp  
;               
;******************************************************
(Defun C:qq (/ 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)
(command "layer" "m" "diast" "")
(setq scl(/ (getreal  "\n select scale  (100,200,500,etc) : ") 100))
(setq ht(* 0.175 scl))

:********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()
;*******CIRCLES ON LANDMARKS***********
(command "style" "diast" "wgsimpl.shx" "" "" "" "" "")
(setq alfa 193)
(command "circle" pt (/ ht 5))
(command "copy" pt "" "m" pt)
(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)))
 
;**************DISTANCES BETWEEN LANDMARKS********************** 
 (setq ptdist (polar 
                    (polar (nth i pllst) angmeta (/ distmeta 2)) 
                    (+ angmeta (* (/ pi 2) flg)) (* 0.25 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.25 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" "")
)


;**********
; (initget "Yes No")
; (setq stryn(getkword "\nSatisfied? (Yes or No) :")) 
; (if (= stryn "Yes")
;     (ok)
; );end if
; (if (= stryn "No")
;     (progn
;           (command "undo" "b")
;           (command "undo" "m")
;           (setq flg(* -1 flg))
;           (main)
;     )
; );end if
; (ok)
;close defun
;(defun ok ()
;*********END*********************************** 
(setvar "osmode" svr)
(setvar "cmdecho" 1)
(setvar "textstyle" txtstl)
(setvar "textsize"  txtsze)
(princ)
);close defun

Thanks

Drawing1.dwg

January 11, 2023

Any options? It can be done?

Thanks

January 12, 2023

Modified this. You will have to add in your scale and angles variables

AD-Automatic Dimension Autocad.LSP

Edited January 12, 2023 by mhupp

January 12, 2023

Hi mhupp. It gives me this error.

Command: (LOAD "E:/Downloads/AD-Automatic Dimension Autocad.LSP") C:AD
Command: ad
ADError: no function definition: GETDICTVAR

I see in the link that use dimensions. I use it for topographic drawings. In topographic drawings, use only text for dimensions. Is it possible to work for text ?

Thanks

January 12, 2023

updated file again.

5 hours ago, prodromosm said:

In topographic drawings, use only text for dimensions. Is it possible to work for text ?

That's what I updated. but your using gradians for angle and can't figure that out so text looks like this.

Edited January 12, 2023 by mhupp

January 12, 2023

Hi mhupp. I add some changes to the code. I try to change the units to degrees in the beginning and to grads at the end, but I still have problem with the angle of the text. I and text style , create it, but the text goes to STANDARD !!!

;AutoDimension polylines
; - draw dimension(s) from vertex to vertex for selected polylines
; - add arc length for arc segments.
; Stefan M. 10.11.2015 - for KimProjects.com

(defun C:AD ( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)

;units to degrees
   (mapcar 'setvar (list 'aunits 'auprec 'angdir 'angbase 'lunits 'luprec 'insunits 'lightingunits) (list 0 4 0 0 2 3 6 2))
;------------Dont delete it, i use it for the text height, I deactivate it for the moment ----------------
;   (setq scl (getvar "useri1"))
;   (setq ht(* 0.00175 scl))
;---------------------------------------------------------------------------------------------------------------------
   (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
   (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        dim (getvar 'dimstyle)
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
  (setq opt (mapcar
              '(lambda (a b)
                 (cond
                   ((getdictvar "AD_otions" a))
                   ((setdictvar "AD_otions" a b))
                   )
                 )
              '("Linear" "Arc")
              '("b0" "c0")
              )
        )
  
 ; (initget "Options")
 ; (if
 ;   (eq (getkword "\nPress enter to continue or [Options]: ") "Options")
 ;   (setq opt (AD_options opt))
 ;   )
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                   )
                 )
               )
        (entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 1 (rtos (distance p1 p2) 2 2)) '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)

;Units to grads
(mapcar 'setvar (list 'aunits 'auprec 'angdir 'angbase 'lunits 'luprec 'insunits 'lightingunits) (list 2 4 1 (/ pi 2) 2 3 6 2))

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


(defun AD_options (old / a1 a2 b1 b2 dcl dcl_id file r)
  (setq
    a1 (car old)
    a2 (cadr old)
    dcl (open (setq file (vl-filename-mktemp "AD" (getvar 'dwgprefix) ".dcl")) "w")
  )
  (write-line
    "AD: dialog { label = \"Dimension Polyline Options\" ;
    : boxed_radio_column { label = \"Linear dimension position\" ; key = \"a1\";
    : radio_button { label = \"Above line\" ; key = \"b0\";}
    : radio_button { label = \"Below line\" ; key = \"b1\";}}
    : boxed_radio_column { label = \"Arc dimension position\" ; key = \"a2\";
    : radio_button { label = \"Inside arc\" ; key = \"c0\";}
    : radio_button { label = \"Outside arc\" ; key = \"c1\";}
    : radio_button { label = \"As for lines\" ; key = \"c2\";}}
    ok_cancel ;}"
    dcl)
  (close dcl)
  (if
    (< 0 (setq dcl_id (load_dialog file)))
    (if
      (new_dialog "AD" dcl_id)
      (progn
        (action_tile "a1" "(setq b1 $value)")
        (action_tile "a2" "(setq b2 $value)")
        (set_tile "a1" (setq b1 a1))
        (set_tile "a2" (setq b2 a2))
        (setq r (start_dialog))
        (unload_dialog dcl_id)
        )
      )
    )
  (if (findfile file) (vl-file-delete file))
  (if
    (= r 1)
    (mapcar 'setdictvar 
      '("AD_otions" "AD_otions")
      '("Linear" "Arc")
      (list b1 b2)
    )
    (list a1 a2)
  )
)
    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)

January 12, 2023

7 minutes ago, prodromosm said:

Hi mhupp. I add some changes to the code. I try to change the units to degrees in the beginning and to grads at the end, but I still have problem with the angle of the text. I and text style , create it, but the text goes to STANDARD !!!

Update the entmake to include the style name '(7 . "style name") and (cons 51 anglevariable)

(entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 1 (rtos (distance p1 p2) 2 2)) '(7 . "diast") '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))

January 12, 2023

Hi, I clean up the code. I don't know if I left something unnecessary. I still have a problem with the angle of the text. Furthermore, I attach a *dwg file will an example how the correct angle must be at the end. Can any one help

(defun c:foo( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)

;------------Dont delete it, i use it for the text height, I deactivate it for the moment ----------------
;   (setq scl (getvar "useri1"))
;   (setq ht(* 0.00175 scl))
;---------------------------------------------------------------------------------------------------------------------
   (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
   (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        dim (getvar 'dimstyle)
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
  (setq opt (mapcar
              '(lambda (a b)
                 (cond
                   ((getdictvar "AD_otions" a))
                   ((setdictvar "AD_otions" a b))
                   )
                 )
              '("Linear" "Arc")
              '("b0" "c0")
              )
        )
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                   )
                 )
               )
        (entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 1 (rtos (distance p1 p2) 2 2)) '(7 . "diast") '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)


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



    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)

Thanks

test.dwg

January 13, 2023

I clean a little more the code. Any ideas how to fix the text angle?

(defun c:foo( / *error* a acdoc b c d scl e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)

;------------Dont delete it, i use it for the text height, I deactivate it for the moment ----------------
;   (setq scl (getvar "useri1"))
;   (setq ht (* 0.00175 scl))
;---------------------------------------------------------------------------------------------------------------------
   (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
   (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
     
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                   )
                 )
               )
        (entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 1 (rtos (distance p1 p2) 2 2)) '(7 . "diast") '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)


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



    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)

Thanks

test(1).dwg

January 14, 2023

Can anyone fix the angle rotation like test(1).dwg ?

Thanks

January 14, 2023

1 hour ago, prodromosm said:

Can anyone fix the angle rotation like test(1).dwg ?

Thanks

For individual polylines

727.LSP

Edited January 14, 2023 by 1958

January 14, 2023

With checking for polyline closure

737.LSP

January 14, 2023

Hi 1958.

1) Is any way all parametric dimension be inside the polygon and only in the sides, will be in touch, have one dimension

2) If it is possible to select window more than one polyline.

3) In topographic drawings, all text for dimensions are inside the polygons.

Thanks

test.dwg

Edited January 14, 2023 by prodromosm

January 14, 2023

Do a check for duplicate texts and delete duplicates. You can write a simple procedure. Sorry for my english, I use translate.google.com

January 14, 2023

Hi, I update the code and correct the angle problem for the text. Work for multiple polylines.

I have these problems :

1) I don't know haw to delete duplicate text

2) The dimension are not all inside the polygon

(defun c:foo( / *error* a acdoc b c d scl e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)

;------------Dont delete it, i use it for the text height, I deactivate it for the moment ----------------
;   (setq scl (getvar "useri1"))
;   (setq ht (* 0.00175 scl))
;---------------------------------------------------------------------------------------------------------------------
   (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
   (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
  (setq opt (mapcar
              '(lambda (a b)
                 (cond
                   ((getdictvar "AD_otions" a))
                   ((setdictvar "AD_otions" a b))
                   )
                 )
              '("Linear" "Arc")
              '("b0" "c0")
              )
        )
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                   )
                 )
               )
        (entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 50 u) (cons 1 (rtos (distance p1 p2) 2 2)) '(7 . "diast") '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)


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



    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)

Can any one help ?

Thanks

Edited January 14, 2023 by prodromosm

January 14, 2023

Hi, I update the code to delete the duplicate dimension.

Can anyone help me to fix dimensions to be all inside the polygon? Like the example?

(defun c:foo3 ( / *error* a acdoc b c d scl e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)

;------------Dont delete it, i use it for the text height, I deactivate it for the moment ----------------
;   (setq scl (getvar "useri1"))
;   (setq ht (* 0.00175 scl))
;---------------------------------------------------------------------------------------------------------------------
   (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
   (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
    
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                   )
                 )
               )
        (entmake (list (cons 0 "TEXT") (cons 10 p3) (cons 11 p3) (cons 40 ht) (cons 50 u) (cons 1 (rtos (distance p1 p2) 2 2)) '(7 . "diast") '(8 . "DIM-TEXT") '(73 . 2) '(72 . 1)))
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)


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



    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)

;; This code delete duplicate text

(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp ans)
  (defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur)
    (setq elist	(entget ent)
	  ang	(cdr (assoc 50 elist))
	  tb	(textbox elist)
	  tb1	(car tb)
	  tb2	(cadr tb)
	  ll	(polar (cdr (assoc 10 elist))
		       (+ (angle '(0 0) tb1) ang)
		       (DISTANCE '(0 0) tb1)
		)
	  lr	(polar ll ang (- (car tb2) (car tb1)))
	  ur	(polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
	  ul	(polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1)))
    )
    (setq ang (angle ll lr))
    (setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
	  lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
	  ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
	  ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
    )
    (list ll lr ur ul)
  )

  (command "_.undo" "be")
  (setq ss (ssget "_X" (list (cons 0 "TEXT")(cons 8 "DIM-TEXT"))) ss1 (ssadd))
  (setq *ofset 0.5)
  (initget 4)
  (if (= ofset nil)
    (setq ofset *ofset)
    (setq *ofset ofset)
  )

  (while (> (sslength ss) 0)
    (setq ent (ssname ss 0)
	  lst (GetBound ent ofset)
    )
    (ssdel ent ss)
    (if	(setq ss_tmp (ssget "cp" lst (list (cons 0 "TEXT"))))
      (progn
	(setq i -1)
	(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
	  (if (not (equal ent ent1))
	    (progn
	      (ssadd ent1 ss1)
	      (if (ssmemb ent1 ss)
		(ssdel ent1 ss)
	      )
	    )
	  )
	)
      )
    )
  )
    (command ".erase" ss1 "")
    (command "_.undo" "e")
    (princ)
  )

test.dwg

January 15, 2023

Multiple selection and removal of duplicates

747.LSP

January 15, 2023

Hi 1958. I try your code but,

1) I use text not mtext

2)The bigger problem is that the half of the dimensions are out of the polygon. I am trying to find a way all the dimension be inside the polygon. All the polyline in my drawings are counterclockwise.

Thanks

January 15, 2023

polyline segment length label (text, non-multiline text)
signatures of common parties are not removed

767.LSP

January 15, 2023

Thanks 1958

Help with dimension lisp

Recommended Posts

Guest

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

1958

Posted Images

Guest

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

1958

Link to comment

Share on other sites

1958

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

1958

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

1958

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

1958

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity