Help with dimension lisp

[1958]

polyline segment length label (text, non-multiline text)
multiple selection and removal of duplicates

787.LSP

[Guest]

Hi 1985. I test the code 787.lsp and is very good. I want an information about the code because I can not find it.  I add some line to change text, the text height with scale of the drawing. The problem is tha if the text height is not 0.18 don't delete the  "duplicate " text.  The question is in what part of the code  I can change by scale type  the distance of the duplicate text to delete it? 

 

 

;;; polyline segment length label (text, non-multiline text)
;;; multiple selection and removal of duplicates
(defun c:787 (/ ss_l k si obj vert n s0 i p1 p2 s ang pt ss sss sst pk1 pk2)
 (vl-load-com)
 ;----------Add this lines ------------------------------
 
    (if (=(tblsearch "layer" "DIM-TEXT") nil)
      (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
     );end if
     (setvar "clayer" "DIM-TEXT")
 (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
 (setq scl (getvar "useri1"))
 (setq ht (* 0.00175 scl))
 ;-------------------------------------------------------------------------
 (setq ss_l (ssget '((0 . "LWPOLYLINE,LINE,ARC")))
       k    (sslength ss_l)
       si   -1
       ;ht   0.18
 )
 (repeat k
  (setq obj  (ssname ss_l (setq si (1+ si)))
        vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
  )
  (if (vla-get-closed (setq obj (vlax-ename->vla-object obj)))
   (setq vert (append vert (list (car vert))))
  )
  (setq n  (1- (length vert))
        s0 0
        i  0
  )
  (repeat n
   (setq p1  (nth i vert)
         p2  (nth (setq i (1+ i)) vert)
         s   (/ (distance p1 p2) 2)
         s0  (+ s0 s)
         ang (angle p1 p2)
         pt  (vlax-curve-getPointAtDist obj s0)
         s0  (+ s0 s)
   )
   (if (> (* pi 1.5) ang (* pi 0.5))
    (setq ang (+ ang pi))
   )
   (setq par  (vlax-curve-getParamAtPoint obj pt)
         fd   (vlax-curve-getFirstDeriv obj par)
         x_fd (car fd)
   )
   (if (> x_fd 0.0)
    (setq pt (polar pt (+ ang (* 0.5 pi)) (* ht 1.5)))
    (setq pt (polar pt (- ang (* 0.5 pi)) (* ht 1.5)))
   )
   (entmakex (list (cons 0 "TEXT")
                   (cons 1 (rtos (* s 2.0) 2 2))
                   (cons 7 "diast")
                   (cons 8 "DIM-TEXT")
                   (cons 10 pt)
                   (cons 11 pt)
                   (cons 40 ht)
                   (cons 50 ang)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
   )
  )
 )
 (setq sst (ssget "_X" (list '(0 . "TEXT") '(8 . "DIM-TEXT"))))
 (setq n   (1- (sslength sst))
       i   0
       k   0
       sss (ssadd)
 )
 (while (< i n)
  (while (< k n)
   (setq pk1 (cdr (assoc 10 (entget (ssname sst i))))
         pk2 (cdr (assoc 10 (entget (setq p2 (ssname sst (setq k (1+ k)))))))
   )
   (if (equal pk1 pk2 1)
    (ssadd p2 sss)
   )
  )
  (setq i (1+ i)
        k i
  )
 )
 (vl-cmdf "_erase" sss "")
)
 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** ΝΕ δξαΰβλιςε ςεκρς οξδ κξμμενςΰπθμθ! ***|;

 

 

[1958]

3 hours ago, prodromosm said:

(if (equal pk1 pk2 1)

Experiment with 1. 1 is the distance between the text insertion points. If the distance is greater than 1, then these texts are not duplicates.

Edited January 16, 2023 by 1958

[Guest]

Hi. 1958.  You help me a lot. Something last. I try to play with delete distance bur ht=0.18 and distance 1 is the better solution. But for my drawings is a problem. I like the part that select all line and dimension them correct  ,and I will stay to delete manual the duplicate text. This code I better than old I have for dimension, so If is not a big trable for you can you delete from the code the delete dimension part  and left the dimnsion part only.

 

Thanks a lot, regards

[Guest]

I think I cleat the code

 

;;; polyline segment length label (text, non-multiline text)
;;; multiple selection and removal of duplicates
(defun c:787 (/ ss_l k si obj vert n s0 i p1 p2 s ang pt ss sss sst pk1 pk2)
 (vl-load-com)
 ;----------Add this lines ------------------------------
 
    (if (=(tblsearch "layer" "DIM-TEXT") nil)
      (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
     );end if
     (setvar "clayer" "DIM-TEXT")
 (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
 (setq scl (getvar "useri1"))
 (setq ht (* 0.00175 scl))
 ;-------------------------------------------------------------------------
 (setq ss_l (ssget '((0 . "LWPOLYLINE,LINE,ARC")))
       k    (sslength ss_l)
       si   -1
       ;ht   0.18
 )
 (repeat k
  (setq obj  (ssname ss_l (setq si (1+ si)))
        vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
  )
  (if (vla-get-closed (setq obj (vlax-ename->vla-object obj)))
   (setq vert (append vert (list (car vert))))
  )
  (setq n  (1- (length vert))
        s0 0
        i  0
  )
  (repeat n
   (setq p1  (nth i vert)
         p2  (nth (setq i (1+ i)) vert)
         s   (/ (distance p1 p2) 2)
         s0  (+ s0 s)
         ang (angle p1 p2)
         pt  (vlax-curve-getPointAtDist obj s0)
         s0  (+ s0 s)
   )
   (if (> (* pi 1.5) ang (* pi 0.5))
    (setq ang (+ ang pi))
   )
   (setq par  (vlax-curve-getParamAtPoint obj pt)
         fd   (vlax-curve-getFirstDeriv obj par)
         x_fd (car fd)
   )
   (if (> x_fd 0.0)
    (setq pt (polar pt (+ ang (* 0.5 pi)) (* ht 1.5)))
    (setq pt (polar pt (- ang (* 0.5 pi)) (* ht 1.5)))
   )
   (entmakex (list (cons 0 "TEXT")
                   (cons 1 (rtos (* s 2.0) 2 2))
                   (cons 7 "diast")
                   (cons 8 "DIM-TEXT")
                   (cons 10 pt)
                   (cons 11 pt)
                   (cons 40 ht)
                   (cons 50 ang)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
   )
  )
 )
)
 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** ΝΕ δξαΰβλιςε ςεκρς οξδ κξμμενςΰπθμθ! ***|;

 

 

Thanks

[1958]

What values can your SCL have?

[Guest]

Hi 1958.  I change  to add a give scale option to be easy to test. I add some dimension on polygons to  have an example .

 

I use this scales

(1:50,1:100,1:200,1:250,1:500,1:1000,1:5000)

 

and I calculate the text size with this code

 

 (setq ht (* 0.00175 scl))

 

The text distance from the polygon is satisfied from your code , the problem is that can not delete the  duplicate disstances or delete more if I try to chane

 

 

(equal pk1 pk2 1)

 

I try to add

 

 (setq ld (* 0.001 scl))
 ..........
..........
.... (equal pk1 pk2 ld)

 

but the most of the time delete more dimension text  !!!!

 

;;; polyline segment length label (text, non-multiline text)
;;; multiple selection and removal of duplicates
(defun c:787 (/ ss_l k si obj vert n s0 i p1 p2 s ang pt ss sss sst pk1 pk2)
 (vl-load-com)
 ;----------Add this lines ------------------------------
 
    (if (=(tblsearch "layer" "DIM-TEXT") nil)
      (command "_layer" "_m" "DIM-TEXT" "_c" "93" "" "_lw" "0.30" "" "")
     );end if
     (setvar "clayer" "DIM-TEXT")
 (command "-style" "diast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
 ;(setq scl (getvar "useri1"))
  (setq scl (getint "\nSet scsle (1:50,1:100,1:200,1:250,1:500,1:1000,1:5000)  1:"))
 (setq ht (* 0.00175 scl))
 ;-------------------------------------------------------------------------
 (setq ss_l (ssget '((0 . "LWPOLYLINE,LINE,ARC")))
       k    (sslength ss_l)
       si   -1
       ;ht   0.18
 )
 (repeat k
  (setq obj  (ssname ss_l (setq si (1+ si)))
        vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
  )
  (if (vla-get-closed (setq obj (vlax-ename->vla-object obj)))
   (setq vert (append vert (list (car vert))))
  )
  (setq n  (1- (length vert))
        s0 0
        i  0
  )
  (repeat n
   (setq p1  (nth i vert)
         p2  (nth (setq i (1+ i)) vert)
         s   (/ (distance p1 p2) 2)
         s0  (+ s0 s)
         ang (angle p1 p2)
         pt  (vlax-curve-getPointAtDist obj s0)
         s0  (+ s0 s)
   )
   (if (> (* pi 1.5) ang (* pi 0.5))
    (setq ang (+ ang pi))
   )
   (setq par  (vlax-curve-getParamAtPoint obj pt)
         fd   (vlax-curve-getFirstDeriv obj par)
         x_fd (car fd)
   )
   (if (> x_fd 0.0)
    (setq pt (polar pt (+ ang (* 0.5 pi)) (* ht 1.5)))
    (setq pt (polar pt (- ang (* 0.5 pi)) (* ht 1.5)))
   )
   (entmakex (list (cons 0 "TEXT")
                   (cons 1 (rtos (* s 2.0) 2 2))
                   (cons 7 "diast")
                   (cons 8 "DIM-TEXT")
                   (cons 10 pt)
                   (cons 11 pt)
                   (cons 40 ht)
                   (cons 50 ang)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
   )
  )
 )
 (setq sst (ssget "_X" (list '(0 . "TEXT") '(8 . "DIM-TEXT"))))
 (setq n   (1- (sslength sst))
       i   0
       k   0
       sss (ssadd)
 )
 (while (< i n)
  (while (< k n)
   (setq pk1 (cdr (assoc 10 (entget (ssname sst i))))
         pk2 (cdr (assoc 10 (entget (setq p2 (ssname sst (setq k (1+ k)))))))
   )
   (if (equal pk1 pk2 1)
    (ssadd p2 sss)
   )
  )
  (setq i (1+ i)
        k i
  )
 )
 (vl-cmdf "_erase" sss "")
)
 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** ΝΕ δξαΰβλιςε ςεκρς οξδ κξμμενςΰπθμθ! ***|;

 

 

Thanks

Drawing2.dwg

Edited January 17, 2023 by prodromosm

[1958]

I added a check for the coincidence of the values of the texts, only the text that is equal to the one under study is deleted.

You still haven't answered about the SCL values.
If 1:50, then scl = 0.05?
If 1:100, then scl = 0.1?
If 1:200, then scl = 0.2?
If 1:250, then scl = 0.25?
If 1:500, then scl = 0.5?
If 1:1000, then scl = 1?
If 1:2000, then scl = 2?
If 1:5000, then scl = 5?

787.LSP

[Guest]

scale 1:200

(setq ht (* 0.00175 scl))

 

So    ht = 0.00175 * 200 = 0.35

 

Your code for scale 1:200 the center of the text is 0.50, is not bad I like it  for scale  1:200 is good

 

So  for the other scales will have something like this, to calculate the distance of the center of the text from the line.

 

(setq txtd (* 0.0025 scl))

 

Thanks

 

 

 

 

[1958]

(if (equal pk1 pk2 1)

1 is not the distance, I was wrong. 1 is the allowable difference in X, Y, Z.
That is, if Xpk1 is not greater than (not less than) Xpk2, and if Ypk1 is not greater than (not less than) Ypk2, and if Zpk1 is not greater than (not less than) Zpk2, then the condition is met, the text repeats and will be deleted. If the difference is greater on at least one of the axes, then the texts are different. You need to deduce a pattern.

[Guest]

Hi 1958. It is complicated . I don't know how to do it !!!!

[1958]

I think I've solved your problem.

787.LSP

[1958]

The last three lines can be deleted:

 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** НЕ добавляйте текст под комментариями! ***|;

 

Or replace it with another text:

 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** DON'T add text under comments! ***|;

 

[Guest]

Thanks work fine.

 

I want to ask   what this last lines do? I have seen them in  other codes .

 

 

 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** DON'T add text under comments! ***|;

 

[mhupp]

looks like a list of values with mapcar and another list of variable names you could set their values with one line of code.

https://www.cadtutor.net/forum/topic/75774-i-need-to-insert-multiple-copies-of-a-block-and-rotate-and-group-them-for-landscape-designs/?do=findComment&comment=599027

Edited January 17, 2023 by mhupp

[Guest]

Thanks

[1958]

3 hours ago, prodromosm said:

Thanks work fine.

 

I want to ask   what this last lines do? I have seen them in  other codes .

 

 

 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** DON'T add text under comments! ***|;

 

This is a message from the Visual LISP Editor for AutoCAD about the successful formatting of the code.