help Modify bearings and distances LISP

September 8, 2023

Hello
For a few days now I have been using the LISP made by Small Fish, LISP is very good, the only problem that it is causing me is that it does

not highlight the points that I have selected and on some occasions I select the same point twice, I would appreciate it if you Please tell me a way to modify that.

ThaEscrumbo1.LSPnk you

September 8, 2023

I'm not sure of your LISP ability, but you could perhaps draw a temporary point, use the redraw command to highlight the point and then one you hit enter delete all the temporary points, clear the highlighting art the same time?

Something maybe with this? - let us know if you want this added to the LISP you found. Could also define the point style to be used for these highlights and other clever stuff but this is the basics I think to do what you want

  (command "point" (getpoint "Select Point")) ; select point
  (redraw (entlast) 3)                        ; highlight point

Do stuff

  (redraw)                                    ; clear highlights

Delete temporary points

September 8, 2023

Try this:

it will create points as you click, delete them later, and highlights these points

(vl-load-com)
(defun C:Escrumbo1 (/ *error* acsp ang atable cnt col dist item osm
                      point_list pt row table_data tmp tmp_data
                      degreeloc minuteloc secondloc AngString
                      MyPoints p)

;;Added this
(defun drawpt ( pt / )
  (setq MyPt
    (entmakex (list
  '(0 . "POINT")
  '(100 . "AcDbEntity")
  '(67 . 0)
  '(410 . "Model")
  '(8 . "0")
  '(100 . "AcDbPoint")
  (cons 10 pt )
  '(210 0.0 0.0 1.0)
  '(50 . 0.0)
    ) ) ;end list,  end entmake
  ); end entmakex
  (redraw (ENTLAST) 3)
  MyPt
)

  (defun *error*  (msg)
    (if (and msg
      (not
        (member msg
         '("console break" "Function cancelled" "quit / exit abort"))))
      (princ (strcat "\nError: " msg))
      )
    (if osm
      (setvar "osmode" osm))
    (princ)
    ) 

(setq osm (getvar "osmode"))
(setvar "osmode" 1)

(setq cnt 1)
(while (setq pt (getpoint
    (strcat "\n  >> Specify point #"
     (itoa cnt)
     " by order (hit Enter to exit) >> ")))

;;Added this line
  (setq MyPoints   (cons (drawpt pt) MyPoints))


  (setq point_list (cons pt point_list)
 cnt    (1+ cnt))
  )
(setq point_list (reverse point_list))

(setq cnt 0)
(while (<= cnt (- (length point_list) 2))
  (setq tmp  (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2)))
         (nth cnt point_list)
         (nth (1+ cnt) point_list))
 tmp_data (cons tmp tmp_data)
 )
  (setq cnt (1+ cnt))
  )
(setq tmp      (list (strcat (itoa (length point_list)) " - 1")
       (last point_list)
       (car point_list))
      tmp_data (cons tmp tmp_data)
      )
(setq tmp_data (reverse tmp_data))
  
(foreach item  tmp_data
(setq ang (angtos(angle (cadr item) (caddr item))4 2);precision 2 - minutes only
      degreeloc (vl-string-position (ascii "d") ang);location of "d"
      minuteloc (vl-string-position (ascii "'") ang);location of '
;;;       secondloc (vl-string-position (ascii "\"") ang);location of "
);setq
(if (= (- minuteloc degreeloc) 2)
(setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10
);if
;;; (if (= (- secondloc minuteloc) 2)
;;; (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10
;;; );if
(setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol
      dist (distance (cadr item) (caddr item))
      dist (strcat (rtos dist 2 2) " m.")
      tmp (list (car item) AngString dist)
      table_data (cons tmp table_data)
);setq
);foreach
  
(setq
       table_data (reverse table_data)
       pt (getpoint "\n  >> Specify insertion point >> ")
       acsp (vla-get-block
            (vla-get-activelayout
            (vla-get-activedocument
            (vlax-get-acad-object))))
      
      atable (vlax-invoke acsp 'AddTable pt
             (+ 2 (length table_data))
             (length (car table_data))
             (* (getvar "textsize") 2.0)
             (* (getvar "textsize") 15))   
);setq


;;Added this loop
(command "regen")
(foreach p MyPoints (entdel p) )


(vla-put-regeneratetablesuppressed atable :vlax-true)
(vla-settextheight atable actitlerow (getvar "textsize"))
(vla-settextheight atable acheaderrow (getvar "textsize"))
(vla-settextheight atable acdatarow (getvar "textsize"))
(vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25))
(vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS")
(vla-settext atable 1 0 "LINES")
(vla-settext atable 1 1 "BEARINGS")
(vla-settext atable 1 2 "DISTANCES")
(setq row 2)
(foreach item  table_data
  (setq col 0)
  (foreach x  item
    (vla-settext atable row col x)
    (vla-setcellalignment atable row col acMiddleCenter)
    (setq col (1+ col)))
  (setq row (1+ row))
  )

  (vla-put-regeneratetablesuppressed atable :vlax-false)

  (*error* nil)

  (princ)
)

September 8, 2023

17 minutes ago, Steven P said:

Try this:

it will create points as you click, delete them later, and highlights these points

(vl-load-com)
(defun C:Escrumbo1 (/ *error* acsp ang atable cnt col dist item osm
                      point_list pt row table_data tmp tmp_data
                      degreeloc minuteloc secondloc AngString
                      MyPoints p)

;;Added this
(defun drawpt ( pt / )
  (setq MyPt
    (entmakex (list
  '(0 . "POINT")
  '(100 . "AcDbEntity")
  '(67 . 0)
  '(410 . "Model")
  '(8 . "0")
  '(100 . "AcDbPoint")
  (cons 10 pt )
  '(210 0.0 0.0 1.0)
  '(50 . 0.0)
    ) ) ;end list,  end entmake
  ); end entmakex
  (redraw (ENTLAST) 3)
  MyPt
)

  (defun *error*  (msg)
    (if (and msg
      (not
        (member msg
         '("console break" "Function cancelled" "quit / exit abort"))))
      (princ (strcat "\nError: " msg))
      )
    (if osm
      (setvar "osmode" osm))
    (princ)
    ) 

(setq osm (getvar "osmode"))
(setvar "osmode" 1)

(setq cnt 1)
(while (setq pt (getpoint
    (strcat "\n  >> Specify point #"
     (itoa cnt)
     " by order (hit Enter to exit) >> ")))

;;Added this line
  (setq MyPoints   (cons (drawpt pt) MyPoints))


  (setq point_list (cons pt point_list)
 cnt    (1+ cnt))
  )
(setq point_list (reverse point_list))

(setq cnt 0)
(while (<= cnt (- (length point_list) 2))
  (setq tmp  (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2)))
         (nth cnt point_list)
         (nth (1+ cnt) point_list))
 tmp_data (cons tmp tmp_data)
 )
  (setq cnt (1+ cnt))
  )
(setq tmp      (list (strcat (itoa (length point_list)) " - 1")
       (last point_list)
       (car point_list))
      tmp_data (cons tmp tmp_data)
      )
(setq tmp_data (reverse tmp_data))
  
(foreach item  tmp_data
(setq ang (angtos(angle (cadr item) (caddr item))4 2);precision 2 - minutes only
      degreeloc (vl-string-position (ascii "d") ang);location of "d"
      minuteloc (vl-string-position (ascii "'") ang);location of '
;;;       secondloc (vl-string-position (ascii "\"") ang);location of "
);setq
(if (= (- minuteloc degreeloc) 2)
(setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10
);if
;;; (if (= (- secondloc minuteloc) 2)
;;; (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10
;;; );if
(setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol
      dist (distance (cadr item) (caddr item))
      dist (strcat (rtos dist 2 2) " m.")
      tmp (list (car item) AngString dist)
      table_data (cons tmp table_data)
);setq
);foreach
  
(setq
       table_data (reverse table_data)
       pt (getpoint "\n  >> Specify insertion point >> ")
       acsp (vla-get-block
            (vla-get-activelayout
            (vla-get-activedocument
            (vlax-get-acad-object))))
      
      atable (vlax-invoke acsp 'AddTable pt
             (+ 2 (length table_data))
             (length (car table_data))
             (* (getvar "textsize") 2.0)
             (* (getvar "textsize") 15))   
);setq


;;Added this loop
(command "regen")
(foreach p MyPoints (entdel p) )


(vla-put-regeneratetablesuppressed atable :vlax-true)
(vla-settextheight atable actitlerow (getvar "textsize"))
(vla-settextheight atable acheaderrow (getvar "textsize"))
(vla-settextheight atable acdatarow (getvar "textsize"))
(vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25))
(vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS")
(vla-settext atable 1 0 "LINES")
(vla-settext atable 1 1 "BEARINGS")
(vla-settext atable 1 2 "DISTANCES")
(setq row 2)
(foreach item  table_data
  (setq col 0)
  (foreach x  item
    (vla-settext atable row col x)
    (vla-setcellalignment atable row col acMiddleCenter)
    (setq col (1+ col)))
  (setq row (1+ row))
  )

  (vla-put-regeneratetablesuppressed atable :vlax-false)

  (*error* nil)

  (princ)
)

Thank you so much,

my LISP level is low, I am reading this tutorial to learn https://www.cadtutor.net/tutorials/autolisp/quick-start.php

I really appreciate your help

September 9, 2023

Maybe use ssad instead of the cons after making the point, (ssadd (entlast) mypoints) then (comand "erase" mypoints "") no need for a foreach. Good idea display a point, may need a pdmode and pdsize as I got a dot using the entmake so maybe would not see the point. pdmode 34 ?

September 9, 2023

Thanks, I couldn't remember pdmode and pdsize ! (It is one I can never remember).

Yes ssadd is much better

Sign In

help Modify bearings and distances LISP

Recommended Posts

Shirofury

Steven P

Steven P

Shirofury

BIGAL

Steven P

Join the conversation

Tutorials

Forums

Activity