Jump to content

help Modify bearings and distances LISP

Shirofury

By Shirofury
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Shirofury Newbie

Shirofury

Posted
Posted

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

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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)
)

 

Link to comment
Share on other sites
Shirofury Newbie

Shirofury

Posted
  • Author
Posted
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

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

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 ?

  • Like 1
Link to comment
Share on other sites

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...