Linear interpolation problem..

Linear interpolation problem..

danglar
Advocate Advocate
2,350 Views
19 Replies
Message 1 of 20

Linear interpolation problem..

danglar
Advocate
Advocate

Hi All.

I slightly modified program to make Linear Interpolation in a Horizontal plan:

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




       (while (not 
         (setq GL1 (nentsel "\nSelect First Boundary Text Value:"))
          ))
         (setq Lvl1 (entget (car GL1)))
          
       (if (> (length Lvl1) 22) 
                  (setq G_val1 (nth 13 Lvl1))
       
         (setq G_Val1 (nth 11 Lvl1))
        )


       (while (not 
         (setq GL2 (nentsel "\nSelect Second Boundary Text Value:"))
          ))
         (setq Lvl2 (entget (car GL2)))
         
       (if (> (length Lvl2) 22) 
                  (setq G_val2 (nth 13 Lvl2))
       
         (setq G_Val2 (nth 11 Lvl2))
        )
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 3))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)

This program working perfect when the boundary values are TEXTs, but I need the same thing for Attributes and nested texts and attributes

 

something like this:

 (member(cdr(assoc 0(entget(car nslLst))))
             '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
           ); 

 

I find some routines for manipulating with these entities (see attached lisps), but it's difficult for me to make a needful combination.

Can somebody help me..

Any help will be very appreciated.

0 Likes
Accepted solutions (3)
2,351 Views
19 Replies
Replies (19)
Message 2 of 20

Kent1Cooper
Consultant
Consultant

If I'm reading that right, it uses a very peculiar way of getting the text content, which is also risky because it depends on that text-content entry being in a specific position in the entity data list, and you can't count on that remaining the same in different versions [they could add another element of entity data, as they did a few versions back to Polylines, which could move the one you want away from the assumed position].  You can get what you want from any of those entity types by finding the 1-code text-content entry [which is the same in entity data for anything that has text content], regardless of where that may fall in the sequence of entries or whether it remains in the same position in the future.  Try [untested] replacing this part:

 

....          
       (if (> (length Lvl1) 22) 
                  (setq G_val1 (nth 13 Lvl1))
       
         (setq G_Val1 (nth 11 Lvl1))
        )
....

with this more "usual" way of extracting text content:

....          
       (setq G_val1 (assoc 1 Lvl1))
....

and similarly with the Lvl2 / G_Val2 parts.

 

There are other improvements I could suggest, but try that change first, and see whether it works.

Kent Cooper, AIA
0 Likes
Message 3 of 20

danglar
Advocate
Advocate

I did some modification according to your notes. You can see it here:

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




       (while (not 
         (setq GL1 (entsel "\nSelect First Boundary Text Value:"))
          ))
         (setq Lvl1 (entget (car GL1)))
          
       (if (> (length Lvl1) 22) 
                  (setq G_val1 (nth 13 Lvl1))
       
        
         (setq G_val1 (assoc 1 Lvl1))

        )


       (while (not 
         (setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
          ))
         
         (setq Lvl2 (assoc 1 GL2)))
         
       (if (> (length Lvl2) 22) 
                  (setq G_val2 (nth 13 Lvl2))
       
       
         (setq G_Val2 (assoc 1 Lvl2))
        )
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 3))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)

but in this case program working not properly

 

something goes wrong but I don't now what...

0 Likes
Message 4 of 20

Kent1Cooper
Consultant
Consultant

You didn't replace all of what I suggested you replace.  Wipe out the entire (if) function and replace it all with the one-line (setq) function, in both the 1 and 2 areas.

Kent Cooper, AIA
0 Likes
Message 5 of 20

danglar
Advocate
Advocate

Kent, I really don't understand what you mean.. Can you explain it more clearly

thank you

0 Likes
Message 6 of 20

Kent1Cooper
Consultant
Consultant

Lvl1 is the entity data list for the first selected object [that's what (entget) gives you].  This part in the original [straightened out a little]:

 

       (if (> (length Lvl1) 22); test expression 
         (setq G_val1 (nth 13 Lvl1)); 'then' expression
         (setq G_val1 (nth 11 Lvl1)); 'else' expression
       ); end (if)

says: "if that entity data list is more than 22 items long, put into the G_val1 variable the 14th item in it [the first item is index number 0 in the (nth) function -- (nth 13) gets the 14th item], otherwise put the 12th item there."  I haven't dug into what makes the difference in the length of the list between different entity types, but obviously there are additional entries in some type(s), and someone has figured out the position of the text-content entry in each type [which as mentioned before can't be counted on to always remain in that same position in the list].  The reason it doesn't work for you with certain entity types is that their text-content entries must fall in some other positions in their respective entity data lists.

 

But what you're looking for is the entity data entry containing the text content, which is always like this: (1 . "TheTextContent"), whether it's Text, Mtext, an Attribute Definition's default value, an Attribute in a Block insertion, or override text in a Dimension, and probably a few other things.  You can get that, wherever it may happen to be in the list, with (assoc 1 Lvl1), for any of those entity types, which is why I'm suggesting this adjustment -- it should allow it to work with selection of any of those without altering any other parts of the code [provided, of course, whatever you select has text content that represents a number that the later code can work with].  There's no reason to care how long the entity data list is or where that entry falls in it, because it will find that entry regardless -- the (if) test that checks for the length is entirely unnecessary.

 

So instead of checking the length of the list with an (if) test, and putting a different entry from the list into that variable depending on the result, just put there the entry that you know holds what you're looking for, without reference to the length of the list or position in it at all.  Remove the entirety of the code lines quoted above, and put in their place:

 

(setq G_val1 (assoc 1 Lvl1))

and the same for the similar code related to Lvl2 and G_val2, substituting those terms ending in 2's into the replacement line.

Kent Cooper, AIA
0 Likes
Message 7 of 20

danglar
Advocate
Advocate

Thank you Kent for wide explanation of the issue.

I deeply analysed all what you sad and did additional changes in this routine

1. Elliminated  function (IF) in all cases mentioned above becouse "..the (if) test that checks for the length is entirely unnecessary."

2. Variables changed according to your pattern

 

(setq G_val1 (assoc 1 Lvl1))

You can see it here:

 

 

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




       (while (not 
         (setq GL1 (entsel "\nSelect First Boundary Text Value:"))
          ))
         (setq Lvl1 (assoc 1 GL1))          
        
                  
         (setq G_val1 (assoc 1 Lvl1))
       
        
         

     


       (while (not 
         (setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
          ))
         
         (setq Lvl2 (assoc 1 GL2)))
         
       
         (setq G_Val2 (assoc 1 Lvl2))
       
       
         
     
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 3))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)

 

 

but anfortunately program still working not properly..

I really don't know where is the source of the problem

0 Likes
Message 8 of 20

ВeekeeCZ
Consultant
Consultant
(setq Lvl1 (assoc 1 GL1))
why?
0 Likes
Message 9 of 20

danglar
Advocate
Advocate

I really don't know why, but it's according to:

(setq Lvl2 (assoc 1 GL2)))

Do you know how to solve this issue?

 

0 Likes
Message 10 of 20

ВeekeeCZ
Consultant
Consultant

I see, then...

 

(setq Lvl2 (assoc 1 GL2));  -- why?

 

 

Ok, let me see... The entsel function returns something like this:

 

(<Entity name: 7ffff08e340> (-60733.0 -1.08124e+006 0.0))

 

 

So why you're trying to get a list with 1 key code if there is none?

0 Likes
Message 11 of 20

danglar
Advocate
Advocate

I see the issue becomes more complicated..

Do you know the way how to avoid this complication?

0 Likes
Message 12 of 20

Kent1Cooper
Consultant
Consultant

@danglar wrote:

....

    (setq Lvl2 (assoc 1 GL2)))

....


That should be as it was originally:

 

(setq Lvl2 (entget GL2))

Kent Cooper, AIA
0 Likes
Message 13 of 20

danglar
Advocate
Advocate

something like this probably:

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




 
         (setq GL1 (entsel "\nSelect First Boundary Text Value:"))
     
         (setq Lvl1 (entget  GL1))
          
       
       
        
         (setq G_val1 (assoc 1 Lvl1))

       

       
         (setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
        
         
         
        (setq Lvl2 (entget GL2))
       
       
       
         (setq G_Val2 (assoc 1 Lvl2))
        
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 3))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)

but still not working...

 

0 Likes
Message 14 of 20

CADaSchtroumpf
Advisor
Advisor

Can it inspire you?

 

(defun Entsel_Getreal ( / ent key n nbr)
  (setq nbr "")
  (princ "\nSelect object / Give numeric value: ")
  (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
    (cond
      ((eq (car key) 2)
        (if (not (member (cadr key) '(46 48 49 50 51 52 53 54 55 56 57)))
          (princ "Caractère incorrect! ")
          (progn
            (setq n (chr (cadr key)))
            (princ n)
            (setq nbr (strcat nbr n))
          )
        )
      )
    )
  )
  (if (eq (car key) 3)
    (if (setq ent (nentselp (cadr key))) (atof (cdr (assoc 1 (entget (car ent))))) (progn (princ "\nEmpty selection") (princ "\n") (setq nbr 0.0)))
    (progn (princ "\n") (atof nbr))
  )
)
(defun c:interpolation ( / )
  (defun interpolation-3p ( / pt lst_pt n X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z)
    (repeat 3
      (initget 9)
      (if lst_pt
        (progn (setq pt (getpoint pt "\nNext point: ")) (grdraw (car lst_pt) pt 1))
        (setq pt (getpoint "\nFirst point: "))
      )
      (while (zerop (caddr pt)) (setq pt (list (car pt) (cadr pt) (Entsel_Getreal))))
      (setq lst_pt (cons pt lst_pt))
    )
    (grdraw pt (last lst_pt) 1)
    (initget 8)
    (while (setq pt (getpoint "\nPoint to interpolate?: "))
      (setq n 0)
      (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr"))
        (mapcar '(lambda (x) (set (read (strcat (car item) (itoa (setq n (1+ n))))) x))
          (mapcar (eval (read (cdr item))) lst_pt)
        )
        (setq n 0)
      )
      (setq
        E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2)))
        E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2)))
        E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2)))
        E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1))
        Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1))
      )
      (command "_.point" "_none" (list (car pt) (cadr pt) Z))
      (print (strcat "Z= " (rtos Z)))
    )
  )
  (defun interpolation-2p ( / pt1 pt2 px pxb pti)
    (defun interp (pt1 pt2 px1 px2 / l_pt pint ptz)
      (setq l_pt (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) (list pt1 pt2 px1 px2)))
      (setq
        pint (inters (car l_pt) (cadr l_pt) (caddr l_pt) (cadddr l_pt) nil)
        ptz (inters pt1 pt2 pint (list (car pint) (cadr pint) (caddr pt1)) nil)
        ptz (list (car pint) (cadr pint) (if ptz (caddr ptz) 0.0))
      )
    )
    (initget 9)
    (setq pt1 (getpoint "\nGive the first point: "))
    (while (zerop (caddr pt1)) (setq pt1 (list (car pt1) (cadr pt1) (Entsel_Getreal))))
    (initget 9)
    (setq pt2 (getpoint pt1 "\nGive the second point: "))
    (while (zerop (caddr pt2)) (setq pt2 (list (car pt2) (cadr pt2) (Entsel_Getreal))))
    (grdraw pt1 pt2 1)
    (while (setq px (getpoint "\nPoint to interpolate?: "))
      (setq pxb (polar px (+ (angle pt1 pt2) (* 0.5 pi)) (distance pt1 pt2)))
      (setq pti (interp pt1 pt2 px pxb))
      (command "_.point" "_none" pti)
      (print (strcat "Z= " (rtos (caddr pti))))
    )
  )
  (initget "Linar Surfacing")
  (if (eq (getkword "\nMode of interpolating (2 points / 3Points) [Linear/Surfacing]? <Linear>: ") "Surfacing")
    (interpolation-3p)
    (interpolation-2p)
  )
  (redraw)
  (prin1)
)
Message 15 of 20

danglar
Advocate
Advocate

another approach with same result:

 

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




 
         (setq GL1 (entsel "\nSelect First Boundary Text Value:"))
     
         (setq Lvl1 (entget (car GL1)))
          
       
       
        
         (setq G_val1 (assoc 1 Lvl1))

       

       
         (setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
        
         
         
        (setq Lvl2 (entget (car GL2)))
       
       
       
         (setq G_Val2 (assoc 1 Lvl2))
        
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 2))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)
0 Likes
Message 16 of 20

Kent1Cooper
Consultant
Consultant
Accepted solution

Sorry, I should have said that should be the same as it was originally with a correct quotation of that original format:

 

  (setq Lvl2 (entget (car GL2)))

 

What (entsel) returns is a list of the entity name and the point at which it was selected.  You can't get entity data from that list, but only from the entity name that is the first item in it.

Kent Cooper, AIA
0 Likes
Message 17 of 20

danglar
Advocate
Advocate

.. and that exactly what I did:

(setq GL1 (entsel "\nSelect First Boundary Text Value:"))
     
         (setq Lvl1 (entget (car GL1)))
          
       
       
        
         (setq G_val1 (assoc 1 Lvl1))

       

       
         (setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
        
         
         
        (setq Lvl2 (entget (car GL2)))
       
       
       
         (setq G_Val2 (assoc 1 Lvl2))

but it's not helps me al all.

 

Curious but this approach works perfect on text items...

Message 18 of 20

Kent1Cooper
Consultant
Consultant
Accepted solution

@danglar wrote:

.. and that exactly what I did:

but it's not helps me al all.

....


I now see that you did in Post 15 -- I was replying to Post 13, in which you took my erroneous advice from Post 12.

 

The code in Post 1 used (nentsel) for selecting the objects, but that in subsequent versions uses only (entsel).  For Text and Mtext and AttDefs with default value, it shouldn't matter, but if you're picking Attributes in Block insertions, it must be the former -- the n stands for "nested," which is what an Attribute is in a Block.  With just (entsel), you'll get the Block, not the Attribute.

 

If you're selecting Mtext [for which (entsel) should also work], does it at least get the string content as intended?  In other words, is the problem in this part of the code, or in what it tries to do with it later?  After trying it, type the variable names that should be string content, preceded by an exclamation point [i.e. !G_Val1 & !G_Val2], and see whether they hold strings.  Also about Mtext, does it have internal formatting?  The number conversion from the string won't work right if there's a color override or something internal to the Mtext content.

Kent Cooper, AIA
Message 19 of 20

danglar
Advocate
Advocate
Accepted solution

Kent, Thank you for your genious advice!

After changing to (nentsel) all started to work perfect!

You can see it here: (now it's work's on Texts, Attributes and nested Texts (Mtexts are not checked yet))

; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
  (dictremove (namedobjdict) dictName)
  (if
    (setq layerEnameList
      (vl-remove
        nil
        (mapcar
          '(lambda (layerName) (tblobjname "layer" layerName))
          layerNameList
        )
      )
    )
    (dictadd
      (namedobjdict)
      dictName
      (entmakex
        (vl-list*
          '(0 . "XRECORD")
          '(100 . "AcDbXrecord")
          (mapcar
            '(lambda (layerEname) (cons 340 layerEname))
            layerEnameList
          )
        )
      )
    )
  )
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")



(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
 (cond ((getdist (strcat "\nSpecify Text Height <" (rtos (getvar 'textsize)) ">: ")))
 ((getvar 'textsize))
 )
 )




 
         (setq GL1 (nentsel "\nSelect First Boundary Text Value:"))
     
         (setq Lvl1 (entget (car GL1)))
          
       
       
        
         (setq G_val1 (assoc 1 Lvl1))

       

       
         (setq GL2 (nentsel "\nSelect Second Boundary Text Value:"))
        
         
         
        (setq Lvl2 (entget (car GL2)))
       
       
       
         (setq G_Val2 (assoc 1 Lvl2))
        
     
      
       (setq p1 (getpoint "Pick Point Range From:"))
       (setq d (getdist p1 "Pick Point Range To:"))
       (setq d (float d))
       
      
           (setq slp1  (-  (atof(cdr G_val2))  (atof(cdr G_val1))))
           (setq slp  (/ slp1 d))
               
(while 
	 (setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
         (setq d1 (distance p1 Txt_pnt))
         (setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp))) 
         (setq val1 (rtos new_lvl 2 2))  
         (command "text" Txt_pnt "" "" val1)  
        )
)
(c:hi)

Thank you for your help Master Kent!

 

0 Likes
Message 20 of 20

ВeekeeCZ
Consultant
Consultant

@danglar wrote:

.. and that exactly what I did:

...

Good, finally you've started to think about the things and not being just a bad copy typist. Keep up doing that!

 

And to answer your previous questions... Yes, I've known how fix those issues.