Author Topic: need lisps  (Read 25535 times)

0 Members and 1 Guest are viewing this topic.

ELOQUINTET

  • Guest
need lisps
« on: November 10, 2003, 11:12:18 AM »
hey guys i'm trying to find a few simple lisps i've seen posted before but can't seem to locate. here's what i want them to do:

1 offset and erase original line

2 draw line between midpoint of two paralell lines

3 mirror objects :basepoint: midpoint between two paralell lines

4 set all colors to bylayer

thanks

dan

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
need lisps
« Reply #1 on: November 10, 2003, 11:25:09 AM »
No.4
Code: [Select]
(defun cotbyl (obj)
        (cond ((= (type obj) 'VLA-OBJECT)
               (vlax-put-property obj 'Color acByLayer)
               (vlax-release-object obj)
               )
              )
        )

Example:
Code: [Select]

(setq obj (vlax-ename->vla-object (car (entsel))))
(cotbyl obj)

works with ver. 2000 - 2002
2004 is different.
TheSwamp.org  (serving the CAD community since 2003)

ELOQUINTET

  • Guest
need lisps
« Reply #2 on: November 10, 2003, 11:55:17 AM »
hmmm thanks mark but i'm having some sort of problem. i copied and pasted the code into vlide. when i hit save it said something about. cannot create _.ls file do you want to spool. remember recently i turned off the setting to create a backup. well i said no. when i type "cotbyl" it ays unknown command. so what's happening now? thanks

dan

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
need lisps
« Reply #3 on: November 10, 2003, 12:14:20 PM »
try this one
Code: [Select]

;;; change selected objects color to 'ByLayer'
;;; ACAD versions 2000-2002
(defun c:c2bl (/ ss parse-ss cotbyl)

  (defun parse-ss (ss / cntr ent obj-lst)
    (setq cntr 0)
    (while
      (setq ent (ssname ss cntr))
       (setq obj-lst
                     (cons (vlax-ename->vla-object ent) obj-lst)
             cntr    (1+ cntr)
             )
       ) ; while
    (if obj-lst (mapcar 'cotbyl obj-lst))
    ) ; defun

  (defun cotbyl (obj)
    (cond ((= (type obj) 'VLA-OBJECT)
           (vlax-put-property obj 'Color acByLayer)
           (vlax-release-object obj)
           )
          )
    )

  (if (setq ss (ssget))
    (parse-ss ss)
    )
  (princ)
  ); defun
TheSwamp.org  (serving the CAD community since 2003)

ELOQUINTET

  • Guest
need lisps
« Reply #4 on: November 10, 2003, 01:00:29 PM »
thanks mark that one works great. i nearly paniced whew.

dan

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
need lisps
« Reply #5 on: November 10, 2003, 03:31:24 PM »
Mark,

Let me ask you this....what about MText that has had the color changed in the editor? is there a way to also implement that?

Rug
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
need lisps
« Reply #6 on: November 10, 2003, 04:14:41 PM »
Quote from: rugaroo
Mark,

Let me ask you this....what about MText that has had the color changed in the editor? is there a way to also implement that?

Rug

yep, but ouch! You're are talking about some work.
TheSwamp.org  (serving the CAD community since 2003)

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
need lisps
« Reply #7 on: November 10, 2003, 04:28:51 PM »
Hehe hehe hehe....does this mean there is work???? lol Just wanted to double check. :)

Rug
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

ELOQUINTET

  • Guest
need lisps
« Reply #8 on: November 10, 2003, 04:57:40 PM »
hey rugaroo get your own thread   :P

dan

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
need lisps
« Reply #9 on: November 10, 2003, 05:35:44 PM »
You said all colors to by layer...well that includes MText too...you just gotta make sure everyone is working hard here lol....Cause honestly I am sick and tired of using the find command to change mtext colors. ;)

Rug
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
need lisps
« Reply #10 on: November 10, 2003, 08:28:00 PM »
Quote
1 offset and erase original line


Great for drawing roof overhangs or closet shelves.

Code: [Select]
;;       DrawOffset.lsp
;;      Created by C. Alan Butler  2003
;;
;;; Draw a poly line and then offset it.
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;
;;
;;
;; error function & Routine Exit
(defun *error* (msg)
  (if (not (member msg
'("console break" "Function cancelled" "quit / exit abort")
      )
    )
     (princ (strcat "\nError: " msg))
  ) ; if
  (princ)
) ;
 ;end error function
;;  pre set global variable, it remember your entry

 ;======================
 ;    Start of Routine
 ;======================
(defun C:DrawO (/ pt1 pt2 usercmd str en1 en2    )
;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setvar "PLINEWID" 0)
  (setq useros (getvar "osmode")
str "")
  (setvar "osmode" 175)
  (prompt "/nPick points, Enter when done.")
  ;;; Draw the pline
  (setq pt1 (getpoint))
  (command "PLINE" pt1 (Setq pt2 (getpoint pt1))) ;_ COMMAND
  (while (setq pt2 (getpoint pt2 "\nNext point: "))(command pt2)) ;_ WHILE
  (command "")
  (princ)
  (setq en1 (entlast))
  (initget 1)
  (setq pto (getpoint "\nSide to offset:"))
  (setq dist (getreal "\nEnter offset distance:"))
  (command "_.offset" dist en1 pto "")
  ;(setq en2 (entlast))
  (entdel en1) ; remove the user drawn line


;;;==========  Exit Sequence  ============
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
;;; Exit quietly
  (princ)

) ;_end of defun

;;; Notify user program ready to use
(prompt "\n Pline Draw & Offest Loaded:   Type 'DrawO' to run it.")
(princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

daron

  • Guest
need lisps
« Reply #11 on: November 11, 2003, 12:34:17 AM »
Don't know what version of cad you're using, but doesn't the express tool, which I believe became a standard tool in 2002, called exoffset already do what you ask and more?

ELOQUINTET

  • Guest
need lisps
« Reply #12 on: November 11, 2003, 09:04:59 AM »
that worked great cab thanks. daron i'm working with 2002 and have express. not aware of an exoffset.

dan

daron

  • Guest
need lisps
« Reply #13 on: November 11, 2003, 09:10:50 AM »
Try it out. It'll offset the line to the current layer or the source layer. It'll do a multiple offset and it'll do a moving sort of offset. You can also select multiple items to offset using these functions.

ELOQUINTET

  • Guest
need lisps
« Reply #14 on: November 11, 2003, 09:18:21 AM »
where do you think it would be. i don't see it in my toolbars pulldown or in my express folder? thanks man

dan