Jump to content

gr-osmode & nentsel-getreal

pyou

By pyou
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pyou Contributor

pyou

Posted
Posted (edited)

Hi, 

 

I cant make gr-osmode and nentsel-getreal work properly. 

I would like to make it work similar to 3d polyline code where i can  hover over and I could see Z value changing in real time. Could this be done?

Also it seems  if I draw circle in 3d environment/different ucs 1) circle changes position randomly. 2) only text shifting to new height and circle stay at the same elevation.

 

Thank you

  

;; https://www.lee-mac.com/consistentrtos.html
;; rtos wrapper  -  Lee Mac
;; A wrapper for the rtos function to negate the effect of DIMZIN
(defun LM:rtos ( real units prec / dimzin result )
    (setq dimzin (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq result (vl-catch-all-apply 'rtos (list real units prec)))
    (setvar 'dimzin dimzin)
    (if (not (vl-catch-all-error-p result))
        result
    )
)



;; testingRtos function for LM:rtos
(defun c:testingRtos ( / real units prec)
	(LM:rtos (setq real (getreal "\nNumber: ")) 2 (setq prec (getint "\nPrecision: ")) )
)

(vl-load-com)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
  (setq n (/ (cadr (getvar "screensize")) 5.0))
  (setq pt (osnap pt-i str-md))
  (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
    (repeat 2
      (setq
        rap (/ (getvar "viewsize") n)
        pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
        pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
        pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
        pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
        pt56 (polar pt (- (/ pi 4.0)) rap)
        pt67 (polar pt (/ pi 4.0) rap)
        pt78 (polar pt (- pi (/ pi 4.0)) rap)
        pt85 (polar pt (+ pi (/ pi 4.0)) rap)
        n (- n 16)
      )
      (if (equal (osnap pt-i md) pt) (setq one_o T))
      (cond
        ((and (eq "_end" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
        )
        ((and (eq "_mid" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
        )
        ((and (eq "_cen" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
        )
        ((and (eq "_nod" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_qua" md) one_o)
          (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
        )
        ((and (eq "_int" md) one_o)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_ins" md) one_o)
          (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
        )
        ((and (eq "_per" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
        )
        ((and (eq "_tan" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt3 pt4 1)
        )
        ((and (eq "_nea" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
        )
      )
    )
    (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
  )
)
(defun nentsel-getreal ( / o mod ent key n nbr)
  (setq o (getvar "osmode"))
  (if (or (zerop o) (eq (boole 1 o 16384) 16384))
    (setq mod "_none")
    (progn
      (setq mod "")
      (mapcar
        '(lambda (xi xs)
          (if (not (zerop (boole 1 o xi)))
            (if (zerop (strlen mod))
              (setq mod (strcat mod xs))
              (setq mod (strcat mod "," xs))
            )
          )
        )
        '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192)
        '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par")
      )
    )
  )
  (setq nbr "")
  (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: "))
  (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (redraw)
        (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
        (if (and (/= mod "_none") (osnap (cadr key) mod))
          (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod))))
        )
      )
      ((eq (car key) 2)
        (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
          (if (eq (cadr key) 8)
            (progn
              (princ (chr 8)) (princ (chr 32)) (princ (chr 8))
              (setq nbr (substr nbr 1 (1- (strlen nbr))))
            )
            (progn
              (setq n (chr (cadr key)))
              (princ n)
              (setq nbr (strcat nbr n))
            )
          )
        )
      )
    )
  )
  (if (eq (car key) 3)
    (if (setq ent (nentselp (cadr key)))
      (progn
        (setq ent (entget (car ent)))
        (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
          (progn
            (setq ent (read (cdr (assoc 1 ent))))
            (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL))
              (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent)
              (progn (princ "\nInvalid text!") (nentsel-getreal))
            )
          )
          (progn
            (setq nbr "")
            (if (osnap (cadr key) mod)
              (setvar "LASTPOINT" (osnap (cadr key) mod))
              (nentsel-getreal)
            )
            (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT"))
          )
        )
      )
      (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal))
    )
    (if (/= nbr "")
      (progn (princ (strcat "\nZ = " nbr)) (atof nbr))
      (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT")))
    )
  )
)

(defun circle_diameter (pt1 pt2)
  (list (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2) (caddr pt1))
        (/ (distance pt1 pt2) 2)
  )
)

(defun c:Test ()
  (setq current-layer (getvar 'clayer)) ; Store the current layer
  
  ; Switch to the default layer
  (command "-layer" "s" "0" "")

  (setq pt1 (getpoint "\nEnter first point of circle's diameter: ")) ; Prompt the user to select the first point
  (setq pt2 (getpoint pt1 "\nEnter second point of circle's diameter: ")) ; Prompt the user to select the second point
  
  ; Select height point
  (setq heightPt (getpoint "\nSelect height point: ")) 
  
  ; Check if the layer "Test" exists, if not, create it
  (if (not (tblsearch "layer" "Test"))
      (progn
          (command "-layer" "m" "Test" "") ; Create layer "Test"
          (princ "\nCreated layer: Test")
      )
  )

  ; Check if the layer "Test_text" exists, if not, create it
  (if (not (tblsearch "layer" "Test_text"))
      (progn
          (command "-layer" "m" "Test_text" "") ; Create layer "Test_text"
          (princ "\nCreated layer: Test_text")
      )
  )
  
  ; Draw the circle
  (setq center-radius (circle_diameter pt1 pt2))
  (setq center (car center-radius))
  (setq radius (cadr center-radius))
  (setq height (caddr heightPt))
  (setq center (list (car center) (cadr center) height))
  
  ; Set current layer to "Test"
  (command "-layer" "s" "Test" "") ; Set current layer to "Test"
  (command "circle" center radius) ; Draw the circle
  
  ; Draw a point at the center of the circle
  (command "._point" center)
  
    ; Modify point display settings
  (command "PDMODE" "2")   ; Set point mode to the specific symbol (mode 34)
  (command "PDSIZE" "0.05") ; Set point size to 0.05 units

  ; Prompt user for desired text
  (setq textChoices '("test1" "test2" "test3" "test4" "test5" "test6" "User to input custom text")) ; Add "User defined" option
  (setq selectedIndex (getint (strcat "\nEnter the index of the desired text choice:\n"
                                       "1. test1\n"
                                       "2. test2\n"
                                       "3. test3\n"
                                       "4. test4\n"
                                       "5. test5\n"
                                       "6. test6\n"
                                       "7. User to input custom text\n" ; Add "User defined" option
                                       "Enter choice (1-7): ")))
  (setq selectedText
        (if (= selectedIndex 7)
            (getstring "\nEnter the custom text: ") ; Prompt for custom text
            (nth (1- selectedIndex) textChoices))) ; Use selected text from the list

    ; Create MTEXT entity above with modified Y-coordinate
    (entmake
        (list
            '(0 . "MTEXT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbMText")
            (cons 8 "Test_text") ; Set the layer to "Test_text"
            (cons 7 "Arial") ; Set the text style to "Arial"
            (cons 1 selectedText) ; Use the selected text
            (cons 40 0.15)    ; Set the text height to 0.15
            (cons 10 (list (car center) (- (cadr center) 0.1) height)) ; Adjusted Y-coordinate
        )
    )

  ; Restore the layer back to the stored layer
  (command "-layer" "s" current-layer "")

  (princ)
)

 

 

3Dpolyline code:

  

(vl-load-com)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
  (setq n (/ (cadr (getvar "screensize")) 5.0))
  (setq pt (osnap pt-i str-md))
  (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
    (repeat 2
      (setq
        rap (/ (getvar "viewsize") n)
        pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
        pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
        pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
        pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
        pt56 (polar pt (- (/ pi 4.0)) rap)
        pt67 (polar pt (/ pi 4.0) rap)
        pt78 (polar pt (- pi (/ pi 4.0)) rap)
        pt85 (polar pt (+ pi (/ pi 4.0)) rap)
        n (- n 16)
      )
      (if (equal (osnap pt-i md) pt) (setq one_o T))
      (cond
        ((and (eq "_end" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
        )
        ((and (eq "_mid" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
        )
        ((and (eq "_cen" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
        )
        ((and (eq "_nod" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_qua" md) one_o)
          (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
        )
        ((and (eq "_int" md) one_o)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_ins" md) one_o)
          (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
        )
        ((and (eq "_per" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
        )
        ((and (eq "_tan" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt3 pt4 1)
        )
        ((and (eq "_nea" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
        )
      )
    )
    (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
  )
)
(defun nentsel-getreal ( / o mod ent key n nbr)
  (setq o (getvar "osmode"))
  (if (or (zerop o) (eq (boole 1 o 16384) 16384))
    (setq mod "_none")
    (progn
      (setq mod "")
      (mapcar
        '(lambda (xi xs)
          (if (not (zerop (boole 1 o xi)))
            (if (zerop (strlen mod))
              (setq mod (strcat mod xs))
              (setq mod (strcat mod "," xs))
            )
          )
        )
        '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192)
        '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par")
      )
    )
  )
  (setq nbr "")
  (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: "))
  (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (redraw)
        (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
        (if (and (/= mod "_none") (osnap (cadr key) mod))
          (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod))))
        )
      )
      ((eq (car key) 2)
        (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
          (if (eq (cadr key) 8)
            (progn
              (princ (chr 8)) (princ (chr 32)) (princ (chr 8))
              (setq nbr (substr nbr 1 (1- (strlen nbr))))
            )
            (progn
              (setq n (chr (cadr key)))
              (princ n)
              (setq nbr (strcat nbr n))
            )
          )
        )
      )
    )
  )
  (if (eq (car key) 3)
    (if (setq ent (nentselp (cadr key)))
      (progn
        (setq ent (entget (car ent)))
        (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
          (progn
            (setq ent (read (cdr (assoc 1 ent))))
            (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL))
              (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent)
              (progn (princ "\nInvalid text!") (nentsel-getreal))
            )
          )
          (progn
            (setq nbr "")
            (if (osnap (cadr key) mod)
              (setvar "LASTPOINT" (osnap (cadr key) mod))
              (nentsel-getreal)
            )
            (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT"))
          )
        )
      )
      (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal))
    )
    (if (/= nbr "")
      (progn (princ (strcat "\nZ = " nbr)) (atof nbr))
      (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT")))
    )
  )
)
(defun c:3dpoly_xy_ENG1 ( / AcDoc Space msg_f msg_n n pt_f lst_pt lst_tmp pt_n nw_pl)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    msg_f "\nSpecify the end of the line .XY from, or [Undo]: "
    msg_n "\nSpecify the end of the line .XY from, or [Close/Undo]: "
    n 0
  )
  (while (null (setq pt_f (getpoint "\nSpecify the starting point of the polyline: .XY from ")))
    (princ "\nIncorrect point.")
  )
  (setq pt_f (trans pt_f 1 0) lst_pt (list (list (car pt_f) (cadr pt_f) (nentsel-getreal))) lst_tmp lst_pt)
  (setvar "LASTPOINT" (car lst_pt))
  (initget "Undo _Undo")
  (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close"))
    (if (listp pt_n)
      (progn
        (setq pt_n (trans pt_n 1 0) lst_pt (cons (list (car pt_n) (cadr pt_n) (nentsel-getreal)) lst_pt) lst_tmp lst_pt)
        (setvar "LASTPOINT" (car lst_pt))
        (setq n (1+ n) pt_f pt_n)
      )
      (if (zerop n)
        (princ "\nAll segments are already undone.")
        (progn
          (setq lst_pt (cdr lst_pt) lst_tmp lst_pt)
          (setvar "LASTPOINT" (car lst_pt))
          (setq n (1- n) pt_f (getvar "lastpoint"))
        )
      )
    )
    (if (< n 1)
      (initget "Undo _Undo")
      (initget "Undo Close _Undo Close")
    )
    (redraw)
    (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
  )
  (redraw)
  (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append (reverse lst_pt))))
  (if (eq pt_n "Close")
    (vlax-put nw_pl 'Closed 1)
  )
  (princ)
)

 

Edited by pyou
Link to comment
Share on other sites
Tsuky Collaborator

Tsuky

Posted
Posted

I don't know if I understood everything!
But like this, can it be suitable? 

(vl-load-com)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
  (setq n (/ (cadr (getvar "screensize")) 5.0))
  (setq pt (osnap pt-i str-md))
  (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
    (repeat 2
      (setq
        rap (/ (getvar "viewsize") n)
        pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
        pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
        pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
        pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
        pt56 (polar pt (- (/ pi 4.0)) rap)
        pt67 (polar pt (/ pi 4.0) rap)
        pt78 (polar pt (- pi (/ pi 4.0)) rap)
        pt85 (polar pt (+ pi (/ pi 4.0)) rap)
        n (- n 16)
      )
      (if (equal (osnap pt-i md) pt) (setq one_o T))
      (cond
        ((and (eq "_end" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
        )
        ((and (eq "_mid" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
        )
        ((and (eq "_cen" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
        )
        ((and (eq "_nod" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_qua" md) one_o)
          (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
        )
        ((and (eq "_int" md) one_o)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_ins" md) one_o)
          (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
        )
        ((and (eq "_per" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
        )
        ((and (eq "_tan" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt3 pt4 1)
        )
        ((and (eq "_nea" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
        )
      )
    )
    (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
  )
)
(defun nentsel-getreal ( / o mod ent key n nbr)
  (setq o (getvar "osmode"))
  (if (or (zerop o) (eq (boole 1 o 16384) 16384))
    (setq mod "_none")
    (progn
      (setq mod "")
      (mapcar
        '(lambda (xi xs)
          (if (not (zerop (boole 1 o xi)))
            (if (zerop (strlen mod))
              (setq mod (strcat mod xs))
              (setq mod (strcat mod "," xs))
            )
          )
        )
        '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192)
        '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par")
      )
    )
  )
  (setq nbr "")
  (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: "))
  (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (redraw)
        (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
        (if (and (/= mod "_none") (osnap (cadr key) mod))
          (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod))))
        )
      )
      ((eq (car key) 2)
        (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
          (if (eq (cadr key) 8)
            (progn
              (princ (chr 8)) (princ (chr 32)) (princ (chr 8))
              (setq nbr (substr nbr 1 (1- (strlen nbr))))
            )
            (progn
              (setq n (chr (cadr key)))
              (princ n)
              (setq nbr (strcat nbr n))
            )
          )
        )
      )
    )
  )
  (if (eq (car key) 3)
    (if (setq ent (nentselp (cadr key)))
      (progn
        (setq ent (entget (car ent)))
        (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
          (progn
            (setq ent (read (cdr (assoc 1 ent))))
            (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL))
              (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent)
              (progn (princ "\nInvalid text!") (nentsel-getreal))
            )
          )
          (progn
            (setq nbr "")
            (if (osnap (cadr key) mod)
              (setvar "LASTPOINT" (osnap (cadr key) mod))
              (nentsel-getreal)
            )
            (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT"))
          )
        )
      )
      (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal))
    )
    (if (/= nbr "")
      (progn (princ (strcat "\nZ = " nbr)) (atof nbr))
      (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT")))
    )
  )
)
(defun c:Test ( / pt1 pt2 height radius dxf_210 center textChoices selectedIndex selectedText)
  (initget 9)
  (setq pt1 (getpoint "\nEnter first point of circle's diameter: "))
  (initget 9)
  (setq pt2 (getpoint pt1 "\nEnter second point of circle's diameter: "))
  (setvar "PDMODE" 2)
  (setvar "PDSIZE" 0.05)
  (setq height (nentsel-getreal))
  (setq radius (* (distance pt1 pt2) 0.5))
  (setq dxf_210 (trans '(0 0 1) 1 0 T))
  (setq pt1 (list (car pt1) (cadr pt1) height))
  (setq pt2 (list (car pt2) (cadr pt2) height))
  (setq center (trans (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) 1 dxf_210))
    (entmake
        (list
            '(0 . "CIRCLE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbCircle")
            (cons 8 "Test")
            (cons 40 radius)
            (cons 10 center)
            (cons 210 dxf_210)
        )
    )
    (entmake
        (list
            '(0 . "POINT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPoint")
            (cons 8 "Test")
            (cons 10 (trans center dxf_210 0))
            (cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
        )
    )
  (setq textChoices '("test1" "test2" "test3" "test4" "test5" "test6" "User to input custom text"))
  (setq selectedIndex (getint (strcat "\nEnter the index of the desired text choice:\n"
                                       "1. test1\n"
                                       "2. test2\n"
                                       "3. test3\n"
                                       "4. test4\n"
                                       "5. test5\n"
                                       "6. test6\n"
                                       "7. User to input custom text\n"
                                       "Enter choice (1-7): ")))
  (setq selectedText
        (if (= selectedIndex 7)
            (getstring "\nEnter the custom text: ")
            (nth (1- selectedIndex) textChoices)))
    (entmake
        (list
            '(0 . "MTEXT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbMText")
            (cons 8 "Test_text")
            (cons 7 "Arial")
            (cons 1 selectedText)
            (cons 40 0.15)
            (cons 10 (trans center dxf_210 0))
            (cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
            (cons 210 dxf_210)
        )
    )
  (princ)
)

 

  • Like 1
Link to comment
Share on other sites
pyou Contributor

pyou

Posted
  • Author
Posted
2 hours ago, Tsuky said:

I don't know if I understood everything!
But like this, can it be suitable? 

(vl-load-com)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
  (setq n (/ (cadr (getvar "screensize")) 5.0))
  (setq pt (osnap pt-i str-md))
  (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
    (repeat 2
      (setq
        rap (/ (getvar "viewsize") n)
        pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
        pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
        pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
        pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
        pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
        pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
        pt56 (polar pt (- (/ pi 4.0)) rap)
        pt67 (polar pt (/ pi 4.0) rap)
        pt78 (polar pt (- pi (/ pi 4.0)) rap)
        pt85 (polar pt (+ pi (/ pi 4.0)) rap)
        n (- n 16)
      )
      (if (equal (osnap pt-i md) pt) (setq one_o T))
      (cond
        ((and (eq "_end" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
        )
        ((and (eq "_mid" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
        )
        ((and (eq "_cen" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
        )
        ((and (eq "_nod" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_qua" md) one_o)
          (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
        )
        ((and (eq "_int" md) one_o)
          (grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
        )
        ((and (eq "_ins" md) one_o)
          (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
        )
        ((and (eq "_per" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
        )
        ((and (eq "_tan" md) one_o)
          (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
          (grdraw pt3 pt4 1)
        )
        ((and (eq "_nea" md) one_o)
          (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
        )
      )
    )
    (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
  )
)
(defun nentsel-getreal ( / o mod ent key n nbr)
  (setq o (getvar "osmode"))
  (if (or (zerop o) (eq (boole 1 o 16384) 16384))
    (setq mod "_none")
    (progn
      (setq mod "")
      (mapcar
        '(lambda (xi xs)
          (if (not (zerop (boole 1 o xi)))
            (if (zerop (strlen mod))
              (setq mod (strcat mod xs))
              (setq mod (strcat mod "," xs))
            )
          )
        )
        '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192)
        '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par")
      )
    )
  )
  (setq nbr "")
  (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: "))
  (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (redraw)
        (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp))
        (if (and (/= mod "_none") (osnap (cadr key) mod))
          (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod))))
        )
      )
      ((eq (car key) 2)
        (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
          (if (eq (cadr key) 8)
            (progn
              (princ (chr 8)) (princ (chr 32)) (princ (chr 8))
              (setq nbr (substr nbr 1 (1- (strlen nbr))))
            )
            (progn
              (setq n (chr (cadr key)))
              (princ n)
              (setq nbr (strcat nbr n))
            )
          )
        )
      )
    )
  )
  (if (eq (car key) 3)
    (if (setq ent (nentselp (cadr key)))
      (progn
        (setq ent (entget (car ent)))
        (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
          (progn
            (setq ent (read (cdr (assoc 1 ent))))
            (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL))
              (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent)
              (progn (princ "\nInvalid text!") (nentsel-getreal))
            )
          )
          (progn
            (setq nbr "")
            (if (osnap (cadr key) mod)
              (setvar "LASTPOINT" (osnap (cadr key) mod))
              (nentsel-getreal)
            )
            (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT"))
          )
        )
      )
      (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal))
    )
    (if (/= nbr "")
      (progn (princ (strcat "\nZ = " nbr)) (atof nbr))
      (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT")))
    )
  )
)
(defun c:Test ( / pt1 pt2 height radius dxf_210 center textChoices selectedIndex selectedText)
  (initget 9)
  (setq pt1 (getpoint "\nEnter first point of circle's diameter: "))
  (initget 9)
  (setq pt2 (getpoint pt1 "\nEnter second point of circle's diameter: "))
  (setvar "PDMODE" 2)
  (setvar "PDSIZE" 0.05)
  (setq height (nentsel-getreal))
  (setq radius (* (distance pt1 pt2) 0.5))
  (setq dxf_210 (trans '(0 0 1) 1 0 T))
  (setq pt1 (list (car pt1) (cadr pt1) height))
  (setq pt2 (list (car pt2) (cadr pt2) height))
  (setq center (trans (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) 1 dxf_210))
    (entmake
        (list
            '(0 . "CIRCLE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbCircle")
            (cons 8 "Test")
            (cons 40 radius)
            (cons 10 center)
            (cons 210 dxf_210)
        )
    )
    (entmake
        (list
            '(0 . "POINT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPoint")
            (cons 8 "Test")
            (cons 10 (trans center dxf_210 0))
            (cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
        )
    )
  (setq textChoices '("test1" "test2" "test3" "test4" "test5" "test6" "User to input custom text"))
  (setq selectedIndex (getint (strcat "\nEnter the index of the desired text choice:\n"
                                       "1. test1\n"
                                       "2. test2\n"
                                       "3. test3\n"
                                       "4. test4\n"
                                       "5. test5\n"
                                       "6. test6\n"
                                       "7. User to input custom text\n"
                                       "Enter choice (1-7): ")))
  (setq selectedText
        (if (= selectedIndex 7)
            (getstring "\nEnter the custom text: ")
            (nth (1- selectedIndex) textChoices)))
    (entmake
        (list
            '(0 . "MTEXT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbMText")
            (cons 8 "Test_text")
            (cons 7 "Arial")
            (cons 1 selectedText)
            (cons 40 0.15)
            (cons 10 (trans center dxf_210 0))
            (cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
            (cons 210 dxf_210)
        )
    )
  (princ)
)

 

This is perfect Tsuky!

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