|
;===================================================================================
; FREEHAND.lsp (Command function for AutoCAD)
; (c) Copyright 2000 TimeSavers for CAD
; from: [url]www.timesaversforcad.com[/url]
;-----------------------------------------------------------------------------------
; Description:
;
; Modifies lines and polylines to appear as if drawn freehand.
; Two things occur:
; 1. Corners are given slight
overlap.
; 2. Lines are given slight "wiggle" to them.
; User can specify degree of both
overlap & wiggle [1 small - 5 large, 0-none]
; Accomplished by first lengthening each
line, then replacing line
; with
LWPOLYLINE(R14) or POLYLINE(<R14) and adding slightly offset
vertices.
;
; Globals: fh_scal(freehand
scale), fh_oscl (overlap
scale), fh_wscl (wiggle scale)
;===================================================================================
(alert "\nChanges made by FREEHAND cannot
\nbe restored once you leave drawing.")
(defun c:freehand (/ *fh:err* o_m c_e fh_s fh_os fh_ws
x ss ssp e ed llc p1 p2 d el ne
vertno ang vertd offd
offang vlst elst lp dsf)
;-ERROR HANDLING
(defun *fh:err* (m)
(or
(member m '("Function cancelled" "quit / exit
abort" "console break"))
(prompt (strcat "\n< " m " >\n"))
)
(setvar "osmode" o_m)(setvar "cmdecho" c_e)
(setq
*error* *e*)(princ)
)
;-GET VALUES/SETUP
(setq *e* (cond
(*e*)(*error*))
*error* *fh:err*
c_e (getvar "cmdecho")
o_m (getvar "osmode")
dsf (getvar "dimscale") ;TSC
(scale)
)
(setvar "cmdecho" 0)
(command "undo" "e" "undo" "g")
(setvar "osmode" 0)
(or (= (type fh_scl) 'REAL)(setq fh_scl
1.0))
(or (= (type fh_oscl) 'INT)(setq fh_oscl 3))
(or (= (type fh_wscl) 'INT)(setq fh_wscl
3))
;-GET FREEHAND SCALE FACTOR
(if (setq fh_s (getreal (strcat "\nFreehand Scale <" (rtos fh_scl
2) ">: ")))
(setq fh_scl fh_s)
)
;-GET AMOUNT OF OVERLAP
(initget "0 1 2 3 4 5")
(if (setq fh_os (getint (strcat "\nLine OVERLAP amount [1 small-5
large, 0 none] <"(itoa fh_oscl)">: ")))
(setq fh_oscl fh_os)
)
(cond ((= fh_oscl 0)(setq fh_os
nil))
((= fh_oscl 1)(setq fh_os
0.2))
((= fh_oscl 2)(setq fh_os
0.7))
((= fh_oscl 3)(setq fh_os
1.2))
((= fh_oscl 4)(setq fh_os
1.7))
((= fh_oscl 5)(setq fh_os
2.2))
)
(initget "0 1 2 3 4 5")
;-GET AMOUNT OF WIGGLE
(if (setq fh_ws (getint (strcat "\nLine WIGGLE amount [1 small-5
large, 0 none] <"(itoa fh_wscl)">: ")))
(setq fh_wscl fh_ws)
)
(cond ((= fh_wscl 0)(setq fh_ws
nil))
((= fh_wscl 1)(setq fh_ws
0.02))
((= fh_wscl 2)(setq fh_ws
0.07))
((= fh_wscl 3)(setq fh_ws
0.12))
((= fh_wscl 4)(setq fh_ws
0.17))
((= fh_wscl 5)(setq fh_ws
0.22))
)
;-SELECT OBJECTS
(if (setq ss (ssget '((-4 . "<OR")(0 . "LINE")(0 .
"LWPOLYLINE")(0 . "POLYLINE")(-4 . "OR>"))))
(progn
(prompt
"\nFREEHAND in progress...")
(if (setq ssp (ssget "P" '((-4 . "<NOT")(0 . "LINE")(-4 . "NOT>"))))
(progn
(setq el (entlast) x 0)
(while (setq ne el el (entnext el)))
(while (<
x (sslength ssp))
(ssdel (setq e (ssname ssp x)) ss)
(command ".explode" e)
(setq x (1+ x))
)
(while (setq ne (entnext ne))(ssadd ne ss))
)
)
(setq x 0)
(while (< x (sslength ss))
(setq e (ssname ss x) ed (entget e))
;-GET NEEDED INFO FROM LINE
(setq llc (list (assoc 8 ed)) ;start Layer/Ltype/Color list
p1 (cdr (assoc 10 ed))
p2 (cdr (assoc 11 ed))
ang (angle p1 p2)
d (distance p1 p2)
)
(if
(assoc 6 ed)(setq llc (cons (assoc 6 ed) llc)))
(if (assoc 62 ed)(setq llc (cons (assoc 62 ed) llc)))
;-CREATE OVERLAP
(if (and fh_os (> d 0))
(progn
;*-overlap distance, adjust # after "dsf" - larger=less
(setq ovlpd (+ (* (/ dsf 160) fh_scl)(* fh_os fh_scl))
p1 (polar p1 ang
(- ovlpd))
p2 (polar p2 ang
ovlpd)
)
(setq ed (subst (cons 10 p1)(assoc 10 ed) ed)
ed (subst (cons 11 p2)(assoc 11 ed) ed)
)
(entmod ed)
(setq d (distance p1
p2))
)
)
;-CREATE WIGGLE
(if (and fh_ws (> d 0))
(progn
(setq vlst nil
lp p1
;*-number of vertices, adjust # after "dsf" -larger=more
vertno (fix (/ d (+ (* (/ dsf 16) fh_scl)(* 3 fh_scl)))) ;;;(+ (* (/ dsf 16) fh_scl) 3)))
vertd (if (> vertno 0)(/ d (1+ vertno)))
;*-offset distance for vertices, adjust # after "dsf" -larger=less
offd (+ (* (/ dsf 480) fh_scl)(* fh_ws fh_scl))
offang (+ ang (/ pi 2))
)
;-MAKE LIST OF VERTICES FOR NEW PLINE
(repeat vertno
(setq lp (polar lp ang
vertd)
vlst (cons (polar lp offang
offd) vlst)
offang (+ offang pi)
)
)
;-DELETE LINE
(entdel e)(setq e nil)
(if (= (substr (getvar "acadver") 1 2) "14")
(progn
(setq elst (list (cons 10 p2)'(40 . 0.0)'(41 . 0.0)'(42 . 0.0)))
(foreach v vlst
(setq elst (append
(list (cons 10 v)'(40 . 0.0)'(41 . 0.0)'(42 . 0.0)) elst))
)
(setq elst (append (list (cons 10 p1)'(40 . 0.0)'(41 . 0.0)'(42 . 0.0)) elst))
(entmake (append '((0 . "LWPOLYLINE")(100 . "AcDbEntity"))
llc
(list '(100 . "AcDbPolyline")
(cons 90 (/ (length elst) 4))
'(70 . 0)
)
elst
))
)
(progn
;-REPLACE WITH PLINE
(entmake (append '((0 . "POLYLINE")(70 . 128)(66 . 1))
llc))
(entmake (append (list '(0 . "VERTEX")(cons 10 p2)) llc))
(foreach
n vlst (entmake (append (list '(0 . "VERTEX")(cons 10 n)) llc)))
(entmake (append (list '(0 . "VERTEX")(cons 10 p1)) llc))
(entmake (cons '(0 . "SEQEND") llc))
)
)
)
)
(setq x (1+ x))
)
(command "undo" "e")
(prompt "\nFreehand complete. ")
)
)
;-RETURN
VALUES
(setvar "osmode" o_m)(setvar "cmdecho" c_e)
(setq *error*
*e*)
(princ)
)
;-END FILE
|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )
GMT+8, 2024-4-28 02:45 , Processed in 0.193858 second(s), 23 queries , Gzip On.
Powered by Discuz! X3.5
© 2001-2024 Discuz! Team.