Program optimization

[mostafa_mashhadi]

How can you optimize the following program? I wrote this program as a beginner, but I want the above program to be optimized without changing the performance

(defun c:line_Offset (/ pt1 pt2 pt3 pt4 ans side1 side2 offsetdist oldsnap)
  (command "textstyle" "Standard")
  (command "pdmode" 35)
  (command "pdsize" 0.015)
  
   
  (setq pt1 (getpoint "\nSpecify a location for point 1 "))
  (setq P1X (car pt1))
  (setq P1Y (cadr pt1))
  (setq P1Z (caddr pt1))
  (setq STDX (rtos P1X 2 3))
  (setq STDY (rtos P1Y 2 3))
  (setq STDZ (rtos P1Z 2 3))
  (setq COORDN (strcat "Y= " STDY))
  (setq COORDE (strcat "X= " STDX))
  (setq COORDZ (strcat "Z= " STDz))
  (setq txt (strcat COORDE " , " COORDN " , " COORDZ))
  (command "cecolor" 210)
  (command "text" "j" "bl" pt1 0.1 0 txt)
  (command "cecolor" 1)
  (command "circle" pt1 0.02)
  (command "cecolor" 255)

  (setq pt2 (getpoint "\nSpecify a location for point 2"))
  (setq P1Xx (car pt2))
  (setq P1Yy (cadr pt2))
  (setq P1Zz (caddr pt2))
  (setq STDXx (rtos P1Xx 2 3))
  (setq STDYy (rtos P1Yy 2 3))
  (setq STDZz (rtos P1Zz 2 3))
  (setq COORDNn (strcat "Y= " STDYy))
  (setq COORDEe (strcat "X= " STDXx))
  (setq COORDZz (strcat "Z= " STDzz))
  (setq txtt (strcat COORDEe " , " COORDNn " , " COORDZz))
  (command "cecolor" 210)
  (command "text" "j" "bl" pt2 0.1 0 txtt)
  (command "cecolor" 1)
  (command "circle" pt2 0.02)
  
  
  (command "cecolor" 92)
  (command "line" pt1 pt2 "")
  (command "cecolor" 255)
  
 
    (setq pt3 (getpoint "\nSpecify Line&Offset Point "))

     (command "cecolor" 92)
    (command "line" pt1 pt2 "")
    (command "cecolor" 255)
     (setq obj (vlax-ename->vla-object (entlast)))
     (setq pt4 (vlax-curve-getclosestpointto obj pt3))

     (command "cecolor" 1)
     (command "point" pt3)
     (setq obj2 (vlax-ename->vla-object (entlast)))
     (setq side1 (rtos (distance pt1 pt4) 2 3))
     (setq side2 (rtos (distance pt4 pt2) 2 3))
     (setq offsetdist (rtos (distance pt3 pt4) 2 3))


     (setq offset (strcat "OFFSET=" offsetdist))
     (setq line (strcat "Line=" side1))
     (command "cecolor" 255)
     (setq PTXT	(getpoint"Specify upper left corner:"))
     (setq THEIGHT (getreal "\nEnter Text Height:")) ;; this line added
     (command "LEADER" pt3 PTXT "" line offset "")
     (setq ELAST (entlast)) ;; this line added
     (setq OBJ (vlax-ename->vla-object ELAST)) ;; this line added
     (vlax-put-property OBJ 'Height THEIGHT) ;; this line added
;;;Whileeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
  (while
    (setq pt3 (getpoint "\nSpecify Line&Offset Point "))

     (command "cecolor" 92)
    (command "line" pt1 pt2 "")
    (command "cecolor" 255)
     (setq obj (vlax-ename->vla-object (entlast)))
     (setq pt4 (vlax-curve-getclosestpointto obj pt3))

     (command "cecolor" 1)
     (command "point" pt3)
     (setq obj2 (vlax-ename->vla-object (entlast)))
     (setq side1 (rtos (distance pt1 pt4) 2 3))
     (setq side2 (rtos (distance pt4 pt2) 2 3))
     (setq offsetdist (rtos (distance pt3 pt4) 2 3))


     (setq offset (strcat "OFFSET=" offsetdist))
     (setq line (strcat "Line=" side1))
     (command "cecolor" 255)
     (setq PTXT	(getpoint"Specify upper left corner:"))
     
     (command "LEADER" pt3 PTXT "" line offset ""))
  ;;;WhileeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeEnddddddddddddddddddd
     



  


  
      (if (not AH:Butts)(load "Multi Radio buttons.lsp"))

      (if (= but nil)(setq but 1))
    
  
    (setq ans (ah:butts but "h" '("Delete lines" "Yes" "No")))
    (if (= ans "Yes")
     (progn
      (vla-delete obj)
      (vla-delete obj2)))
    
  
  (setvar 'osmode oldsnap)
  (Princ)

  (c:p2pp))

 

[Tsuky]

I have give a code here on similar subject Line and offset

 

Resume your thread instead of creating a new one, because we no longer have the previous discussion to understand your train of thought...

However, by reviewing and modifying my proposed code, we could see it like this: (entmake) is more efficient than calls to (command).

Please note that the results are given in the WCS even if you are in a UCS or the entities are in a particular UCS.

 

(defun make_text (pt str / )
  (entmake
    (list
      '(0 . "MTEXT")
      '(100 . "AcDbEntity")
      '(100 . "AcDbMText")
      '(62 . 210)
      (if (< (car l_p) (car p3))
        (cons 71 3)
        (cons 71 1)
      )
      (cons 10 pt)
      (cons 40 (getvar "TEXTSIZE"))
      (cons 1 str)
    )
  )
)
(defun c:line_offset ( / old_styl txt_size p1 p2 p3 p4 px dx dy l_p)
  (setq old_styl (getvar "TEXTSTYLE"))
  (setvar "TEXTSTYLE" "Standard")
  (initget 6)
  (if (setq txt_size (getdist (getvar "VIEWCTR") (strcat "\nNew textsize <" (rtos (getvar "TEXTSIZE")) ">: ")))
    (setvar "TEXTSIZE" txt_size)
  )
  (mapcar 'setvar '("PDMODE" "PDSIZE") (list 35 (* 0.25 (getvar "TEXTSIZE"))))
  (initget 9)
  (setq p1 (trans (getpoint "\nFirst point: ") 1 0))
  (initget 9)
  (setq p2 (trans (getpoint (trans p1 0 1) "\nSecond point: ") 1 0))
  (entmake
    (list
      '(0 . "LINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbLine")
      '(62 . 3)
      (cons 10 p1)
      (cons 11 p2)
    )
  )
  (mapcar
    '(lambda (x) (make_text (car x) (cdr x)))
    (list
      (cons
        (polar p1 0.0 (getvar "TEXTSIZE"))
        (strcat "X: " (rtos (car p1)) "\\PY: " (rtos (cadr p1)) "\\PZ: " (rtos (caddr p1)))
      )
      (cons
        (polar p2 0.0 (getvar "TEXTSIZE"))
        (strcat "X: " (rtos (car p2)) "\\PY: " (rtos (cadr p2)) "\\PZ: " (rtos (caddr p2)))
      )
    )
  )
  (mapcar
    '(lambda (p / )
      (entmake
        (list
          '(0 . "CIRCLE")
          '(100 . "AcDbEntity")
          '(62 . 1)
          '(100 . "AcDbCircle")
          (cons 10 p)
          '(40 . 0.02)
        )
      )
    )
    (list p1 p2)
  )
  (initget 9)
  (while (setq p3 (getpoint "\nPoint to calculate?:"))
    (setq
      p3 (trans p3 1 0)
      p4 (polar p3 (+ (angle p1 p2) (* 0.5 pi)) (distance p1 p2))
      px
      (inters
        (list (car p1) (cadr p1) 0.0)
        (list (car p2) (cadr p2) 0.0)
        (list (car p3) (cadr p3) 0.0)
        (list (car p4) (cadr p4) 0.0)
        nil
      )
    )
    (if (not (equal (caddr p1) (caddr p2) 1E-13))
       (setq px (inters px (list (car px) (cadr px) (apply 'max (mapcar 'caddr (list p1 p2)))) p1 p2 nil))
       (setq px (list (car px) (cadr px) (caddr p1)))
    )
    (setq
      dx (distance p1 px)
      p3 (list (car p3) (cadr p3) (caddr px))
      dy (distance px p3)
    )
    (entmake
      (list
        '(0 . "POINT")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPoint")
        '(62 . 1)
        (cons 10 p3)
      )
    )
    (initget 1)
    (setq
      l_p (trans (getpoint (trans p3 0 1) "\nSpecify upper left corner: ") 1 0)
      l_p (list (car l_p) (cadr l_p) (caddr px))
    )
    (entmake
      (list
        '(0 . "LEADER")
        '(100 . "AcDbEntity")
        '(100 . "AcDbLeader")
        '(62 . 210)
        '(73 . 0)
        (if (< (car l_p) (car p3))
          '(74 . 1)
          '(74 . 0)
        )
        '(75 . 1)
        '(76 . 3)
        (cons 10 p3)
        (cons 10 l_p)
        (if (< (car l_p) (car p3))
          (cons 10 (polar l_p pi (getvar "TEXTSIZE")))
          (cons 10 (polar l_p 0.0 (getvar "TEXTSIZE")))
        )
      )
    )
    (mapcar
      '(lambda (x) (make_text (car x) (cdr x)))
      (list
        (cons
          (polar
            (if (< (car l_p) (car p3))
              (polar l_p pi (getvar "TEXTSIZE"))
              (polar l_p 0.0 (getvar "TEXTSIZE"))
            )
            (* 0.5 pi) (getvar "TEXTSIZE")
          )
          (strcat "Line: " (rtos dx) "\\POFFSET: " (rtos dy))
        )
      )
    )
  )
  (setvar "TEXTSTYLE" old_styl)
  (prin1)
)

 

[BIGAL]

Micro seconds difference, but reduces number of variables.

 

  (setq COORDN (strcat "Y= " (rtos (cadr pt1) 2 3))))
  (setq COORDE (strcat "X= " (rtos (car pt1) 2 3)))
  (setq COORDZ (strcat "Z= " (rtos (caddr pt1) 2 3))))

 

Note a space at the end it just makes the display better when doing say getstring.

(setq PTXT	(getpoint"\nSpecify upper left corner: "))