Lisp for holes ID

[Phiphi]

Needing you to modify the attached Lisp from http://www.asmitools.com/Files/Lisps/Ordi.html to select holes then place text as following format:

* On the left h/s of holes: Diameter X Y

* On the right h/s of holes: Y X Diameter

Please download the attachment file for more details.

Any help is greatly appreciated

Thanks you.

Lisp for Holes ID.zip

[fixo]

Needing you to modify the attached Lisp from http://www.asmitools.com/Files/Lisps/Ordi.html to select holes then place text as following format:

* On the left h/s of holes: Diameter X Y

* On the right h/s of holes: Y X Diameter

Please download the attachment file for more details.

Any help is greatly appreciated

Thanks you.

 

I can't edit ordi.lsp to your suit

just give a try another one that

slightly tested on your drawing

 

(defun C:LC (/ ang base color dia ds elist en ent ep layer p1 p2 p3
       pt rad sp txtheight txtstyle xs xv ys yv)
 (setvar "osmode" 32)
 (setvar "orthomode" 1)
 (setq txtheight 35.0
txtstyle "ISOCP"
layer "DIMS"
color 2
)
(setq base (getpoint "\nPick base point (red cross): "))
 (while (setq ent (entsel "\nSelect circle (or press Enter to Exit)>> "))
   (setq en (car ent)
 elist (entget en)
 pt (cdr (assoc 10 elist))
  xv (abs (- (car base)(car pt)))
  xs (rtos xv 2 0)
  yv (abs (- (cadr base)(cadr pt)))
  ys (rtos yv 2 0)
 rad (cdr (assoc 40 elist))
  dia (* rad 2)
  ds (rtos dia 2 1)
  )
(setq ep (getpoint pt "\nSpecify end point of leader line >>"))
(setq ang (angle pt ep)
     ep (polar pt ang 700)
     sp (polar pt ang dia)
     p1 (polar pt ang 250)
     p2 (polar p1 ang 150)
     p3 (polar p2 ang 150)
     p1 (polar p1 (/ pi 2) (/ txtheight 2))
     p2 (polar p2 (/ pi 2) (/ txtheight 2))
     p3 (polar p3 (/ pi 2) (/ txtheight 2))
     )
(entmake (list '(0 . "LINE")
               '(100 . "AcDbEntity")
        (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
      (cons 410 (getvar "ctab"))
      (cons 8 layer)
      (cons 62 7)
               '(100 . "AcDbLine")

               (cons 10 sp)
               (cons 11 ep)
         ) 
)
(entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
      (cons 410 (getvar "ctab"))
      (cons 8 layer)
      (cons 62 color)
      '(100 . "AcDbText")
      (cons 10 p1)
      (cons 11 (list (car p1) (- (cadr p1) (/ txtheight 2)) 0.0))
      (cons 40 txtheight)
      (cons 1 ys)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
      (cons 7  txtstyle)
      '(71 . 0)
      '(72 . 1)
      '(73 . 1)))
   (entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
      (cons 410 (getvar "ctab"))
      (cons 8 layer)
      (cons 62 color)
      '(100 . "AcDbText")
      (cons 10 p2)
      (cons 11 (list (car p2) (- (cadr p2) (/ txtheight 2)) 0.0))
      (cons 40 txtheight)
      (cons 1 xs)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
      (cons 7  txtstyle)
      '(71 . 0)
      '(72 . 1)
      '(73 . 1)))
   (entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
      (cons 410 (getvar "ctab"))
      (cons 8 layer)
      (cons 62 color)
      '(100 . "AcDbText")
      (cons 10 p1)
      (cons 11 (list (car p3) (- (cadr p3) (/ txtheight 2)) 0.0))
      (cons 40 txtheight)
      (cons 1 ds)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
      (cons 7  txtstyle)
      '(71 . 0)
      '(72 . 1)
      '(73 . 1)))
   )
 (princ)
 )
(prompt "\n   >>>   Type LC to run...")
(prin1)

 

~'J'~

[Phiphi]

Thanks a lot, fixo

The Lisp is OK but if you can make the leader line working as command _dimordinate so that we can place it anywhere we like. The Lisp will be perfect.

Cheers,

PP.

[fixo]

Thanks a lot, fixo

The Lisp is OK but if you can make the leader line working as command _dimordinate so that we can place it anywhere we like. The Lisp will be perfect.

Cheers,

PP.

 

Hiya, Phiphi, good morning

 

Now is too late on my side of the planet

 

Will try to help you tomorrow only

 

Cheers

 

~'J'~

[Phiphi]

Many thanks, fixo.

Please see attachment file for some detailed parts.

Cheers!

[fixo]

Many thanks, fixo.

Please see attachment file for some detailed parts.

Cheers!

 

Here is previous lisp give that a try

(partially borrowed from ASMI's lisp)

I will look at your new drawing a bit later

 

;; local defun  
(defun dxf (key elist)
 (cdr (assoc key elist))
 )
;; main part  
(defun C:LC (/ *error* ang base color dia ds dxflist elist en ent ep layer osm ort
       p1 p2 p3 pt rad sp txtheight txtstyle xs xv ys yv vpt)
 ;; error trapping routine
 (defun *error* (msg)
 (if
   (and msg
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
 )
   (princ (strcat "\n** Error: " msg " **"))
   (princ "\nError!")
   )
 (command "undo" "end")  
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))

)
 (command "undo" "begin")
 (setq osm (getvar "osmode"))
 (setvar "osmode" 32)
 (setq ort (getvar "orthomode"))
 (setvar "orthomode" 0)
 (setq txtheight 35.0
txtstyle "ISOCP"
layer "DIMS"
color 2
)
(setq base (getpoint "\nPick base point (red cross): "))
 (while (setq ent (entsel "\nSelect circle (or press Enter to Exit)>> "))
   (setq en (car ent)
 elist (entget en)
 pt (cdr (assoc 10 elist))
  xv (abs (- (car base)(car pt)))
  xs (rtos xv 2 0)
  yv (abs (- (cadr base)(cadr pt)))
  ys (rtos yv 2 0)
 rad (cdr (assoc 40 elist))
  dia (* rad 2)
  ds (rtos dia 2 1)
  )
(command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)

(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )

(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )

(entmod dxflist)

(entupd (entlast))

   )
(*error* nil) 
(princ)
 )
(prompt "\n   >>>   Type LC to run...")
(prin1)

 

~'J'~

[Phiphi]

Thanks Fixo.

Wishing you Merry Christmas & a Happy New Year!

[fixo]

Thanks Fixo.

Wishing you Merry Christmas & a Happy New Year!

 

II would like to wish you and your family a very nice Merry Christmas & a Happy New Year!

GOD BLESS YOU!

THANKS,

~'J'~

[Phiphi]

;; local defun  
(defun dxf (key elist)
 (cdr (assoc key elist))
 )
;; main part  
(defun C:LC (/ *error* ang base color dia ds dxflist elist en ent ep layer osm ort
       p1 p2 p3 pt rad sp txtheight txtstyle xs xv ys yv vpt)
 ;; error trapping routine
 (defun *error* (msg)
 (if
   (and msg
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
 )
   (princ (strcat "\n** Error: " msg " **"))
   (princ "\nError!")
   )
 (command "undo" "end")  
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))

)
 (command "undo" "begin")
 (setq osm (getvar "osmode"))
 (setvar "osmode" 32)
 (setq ort (getvar "orthomode"))
 (setvar "orthomode" 0)
 (setq txtheight 35.0
txtstyle "ISOCP"
layer "DIMS"
color 2
)
(setq base (getpoint "\nPick base point (red cross): "))
 (while (setq ent (entsel "\nSelect circle (or press Enter to Exit)>> "))
   (setq en (car ent)
 elist (entget en)
 pt (cdr (assoc 10 elist))
  xv (abs (- (car base)(car pt)))
  xs (rtos xv 2 0)
  yv (abs (- (cadr base)(cadr pt)))
  ys (rtos yv 2 0)
 rad (cdr (assoc 40 elist))
  dia (* rad 2)
  ds (rtos dia 2 1)
  )
(command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)

(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )

(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )

(entmod dxflist)

(entupd (entlast))

   )
(*error* nil) 
(princ)
 )
(prompt "\n   >>>   Type LC to run...")
(prin1)

 

~'J'~

Hi Fixo,

I have got a problem when select a block of circle. Could you please help to fix this and by the way can you add an option to allow selecting any endpoint then place texts as same as nomal format but replace "Note" instead the diameter of circle.

Left side: Note X Y

Right side: Y X Note

Thank you.

[fixo]

Hi Fixo,

I have got a problem when select a block of circle. Could you please help to fix this and by the way can you add an option to allow selecting any endpoint then place texts as same as nomal but place "Note" instead the diameter of circle.

Left side: Note X Y

Right side: Y X Note

Thank you.

Hi, Phiphi

This is not clearly enough for me: what this means

- block of circle?

Better yet you could be upload a picture or

a sample drawing with explanation (as A2007 or older version)

 

~'J'~

[Phiphi]

Thanks for your quick reply, Fixo.

Just upload the drawing in the previous post.

PP.

[fixo]

Thanks for your quick reply, Fixo.

Just upload the drawing in the previous post.

PP.

 

Hi PP

Try this one instead

(See command prompts)

 

 
;; local defun  
(defun dxf (key elist)
 (cdr (assoc key elist))
 )
;;;;; main part  
(defun C:NL (/ *error *base bname color dia ds dxflist elist en layer
       note ort osm pt rad resp sset txtheight
       txtstyle vpt xs xv ys yv)

 ;; error trapping routine
 (defun *error* (msg)
 (if
   (and msg
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
 )
   (princ (strcat "\n** Error: " msg " **"))
   (princ "\nError!")
   )
 (command "undo" "end")  
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))
 (princ)
)
 (command "undo" "begin")
 (setq osm (getvar "osmode"))
 (setvar "osmode" 32)
 (setq ort (getvar "orthomode"))
 (setvar "orthomode" 0)
 (setq txtheight 35.0
txtstyle "ISOCP"
layer "DIMS"
color 2
)
(setq base (getpoint "\nPick base point (red cross): "))
(prompt "\n\t\t\t>>> Select circle or block (or press Enter to Exit) >> ")
(while (setq sset (ssget "+.:E:S" (list (cons -4 "<OR")
    (cons 0 "INSERT")
    (cons 0 "CIRCLE")
    (cons -4 "OR>"))))

 (setq en (ssname sset 0)
 elist (entget en)
)
 (if (eq "CIRCLE" (dxf 0 elist))
   (progn
 (setq pt  (dxf 10 elist)
       xv  (abs (- (car base) (car pt)))
       xs  (rtos xv 2 0)
       yv  (abs (- (cadr base) (cadr pt)))
       ys  (rtos yv 2 0)
       rad (dxf 40 elist)
       dia (* rad 2)
       ds  (rtos dia 2 1)
       )
     (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)

(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )

(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )

(entmod dxflist)

(entupd (entlast))
   )
   (progn
     (setq pt   (dxf 10 elist)
    xv   (abs (- (car base) (car pt)))
    xs   (rtos xv 2 0)
    yv   (abs (- (cadr base) (cadr pt)))
    ys   (rtos yv 2 0))
     (setq obj (vlax-ename->vla-object en))
     (vla-getboundingbox obj 'minp 'maxp)
     (setq bp (vlax-safearray->list minp)
    up (vlax-safearray->list maxp)
    dia (abs (- (car up)(car bp)))
    ds   (rtos dia 2 1)
    )
           (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)

(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )

(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )

(entmod dxflist)

(entupd (entlast))
  )

)
)
(initget "Yes No")
 (setq resp (getkword "\nDo you want to draw notes? [Yes/No] <Y>: "))
 (if (not resp)(setq resp "Yes"))
 (if (eq "Yes" resp)
   (progn
     (setvar "osmode" 33)
   (while (setq pt (getpoint "\nPick point (or press Enter to Exit): "))
     (setq note (getstring T "\nEnter note text: "))
     (setq xv (abs (- (car base) (car pt)))
    xs (rtos xv 2 0)
    yv (abs (- (cadr base) (cadr pt)))
    ys (rtos yv 2 0)
    )
(command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" note) pause)

(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )

(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat note " \t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" note))(assoc 1 dxflist) dxflist))
 )

(entmod dxflist)

(entupd (entlast))
   )
     )
   )

(*error* nil) 
(princ)
 )
(vl-load-com)
(prompt "\n   >>>   Type NL to run...")
(prin1)

 

This will work just with circles and with blocks as circle shapes

 

~'J'~

[Phiphi]

Thanks fixo,

It seem something wrong with diameter of circle's block. Please check this drawings. Cheers.

Holes- Blocks.dwg

[fixo]

Thanks fixo,

It seem something wrong with diameter of circle's block. Please check this drawings. Cheers.

Hi, PP

 

I edited lisp above

Try again

 

~'J'~

[Phiphi]

Thank a lot, fixo.

It works very good now.

Cheers!

PP.

[fixo]

Thank a lot, fixo.

It works very good now.

Cheers!

PP.

 

Glad to help

 

Cheers

 

~'J'~