TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: fmn76 on July 19, 2007, 11:28:53 PM
-
Hi..there.. i have a problem to generate my symbols cutting.. Manually i just used command 'measure' then i scale that blocks.. how to make this so fast.... c below... sorry my english not so good.
-
Welcome to the Swamp.
What i your primary language?
Perhaps a sample DWG will help explain your request as I don't understand yet.
-
I imagine Prompt something like :-
Select "Top Cutting" line (at start end) :
Select "Btm Cutting" line :
Nominate symbol spacing :
logic ;
locate symbol block spaced along and aligned with the top line, scaled so that the symbol is contained between and touching both the top an bottom lines (refer appendix 3.2 for sketch detail)
-
hmmm.. like that Kerry....
-
Sortof Like this ??
-
Code and attachments ..
this is metric 'cause I work metric.
The block is uniformly scaled, built at 1 unit length.
all care, no responsibility ;-)
enjoy,
/// kwb
(DEFUN c:test (/ SETOUTANGLE
INSERTPOINT L01-DATA
L01-END L01-ENT
L01-PP L01-START
L02-DATA L02-END
L02-ENT L02-PP
L02-START RET
ROTANG SETOUTPOINT
SYMBOLCOUNT SYMBOLSCALE
SYMBOLSPACING TMP
TOPLENGTH
;;
_insertSymbol
)
;;
;; codehimbelonga kwb@theswamp 20070720
;;;----------------------------------------
;; add error trapping
;;;----------------------------------------
(DEFUN _insertSymbol (/)
(SETQ tmp (INTERS
;;(POLAR insertPoint (+ g:setoutAngle (* PI 1.5)) 1) <<-- kwb
(POLAR insertPoint (+ setoutAngle (* PI 1.5)) 1)
insertPoint
L02-start
L02-end
nil
)
rotang (ANGLE insertPoint tmp)
SymbolScale (ABS (DISTANCE insertPoint tmp))
)
(VL-CMDF "-Insert"
"cut-symbol"
insertPoint
(RTOS SymbolScale)
(kdub:rtd rotang)
)
)
;;;----------------------------------------
(SETQ tmp (kdub:objsel "Select Top line at start end "
'("LINE" "LWPOLYLINE")
T
)
L01-ent (CAR tmp)
L01-data (ENTGET L01-ent)
L01-pp (OSNAP (CADR tmp) "nea")
)
(SETQ tmp (kdub:objsel "Select Bottom line "
'("LINE" "LWPOLYLINE")
T
)
L02-ent (CAR tmp)
L02-data (ENTGET L02-ent)
L02-pp (OSNAP (CADR tmp) "nea")
)
;;
;; Top Line
(IF (= "LWPOLYLINE" (kdub:getass 0 L01-data))
(SETQ ret (kdub:getsegment L01-ent L01-pp)
L01-start (CADR ret)
L01-end (CADDR ret)
)
(SETQ L01-start (kdub:getass 10 L01-data)
L01-end (kdub:getass 11 L01-data)
)
)
;;
;; Bottom Line
(IF (= "LWPOLYLINE" (kdub:getass 0 L02-data))
(SETQ ret (kdub:getsegment L02-ent L02-pp)
L02-start (CADR ret)
L02-end (CADDR ret)
)
(SETQ L02-start (kdub:getass 10 L02-data)
L02-end (kdub:getass 11 L02-data)
)
)
;;----------
(SETQ setoutPoint (IF (< (DISTANCE L01-start L01-pp)
(DISTANCE L01-end L01-pp)
)
L01-start
L01-end
)
setoutAngle (ANGLE setoutPoint L01-pp)
TopLength (DISTANCE L01-start L01-end)
;;---
SymbolSpacing (GETDIST (STRCAT "\nSymbol spacing (Top Length is "
(RTOS TopLength)
") : "
)
)
SymbolCount (FIX (/ (- TopLength (* 0.5 SymbolSpacing))
SymbolSpacing
)
)
insertPoint (POLAR setoutPoint
setoutAngle
(* 0.5 SymbolSpacing)
)
)
;;(VL-CMDF "point" setoutPoint)
;;(VL-CMDF "point" insertPoint)
(_insertSymbol)
(REPEAT SymbolCount
(SETQ insertPoint
(POLAR insertPoint setoutAngle SymbolSpacing)
)
(_insertSymbol)
)
(PRINC)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;; library Routines
;;;------------------------------------------------------------------
(DEFUN kdub:2dPoint (Point) (LIST (CAR Point) (CADR Point)))
;;;------------------------------------------------------------------
(DEFUN kdub:rtd (ang) (/ (* ang 180.0) PI))
;;;------------------------------------------------------------------
(DEFUN kdub:getsegment (obj pt / cpt eparam stparam)
;; original ver by Stig Madsen
;;
(COND ((SETQ cpt (VLAX-CURVE-GETCLOSESTPOINTTO obj pt T))
(SETQ eparam (FIX (VLAX-CURVE-GETENDPARAM obj)))
(IF (= eparam
(SETQ stparam
(FIX (VLAX-CURVE-GETPARAMATPOINT obj cpt)
)
)
)
(SETQ stparam (1- stparam))
(SETQ eparam (1+ stparam))
)
(LIST eparam
(VLAX-CURVE-GETPOINTATPARAM obj stparam)
(VLAX-CURVE-GETPOINTATPARAM obj eparam)
)
)
)
)
;;;------------------------------------------------------------------
(DEFUN kdub:getass (key data /) (CDR (ASSOC key data)))
;;;------------------------------------------------------------------
;; typelist : List of entity types allowed to be selected
;; nentselflag : If true nentsel permitted , otherwise use entsel.
;;
(DEFUN kdub:objsel
(Promptmsg typelist nentselflag / pickok returnvalue tmp)
(SETQ Promptmsg (STRCAT "\n"
(COND (Promptmsg)
("Select object")
)
" : "
)
)
(WHILE (NOT pickok)
(SETVAR "ERRNO" 0)
(SETQ returnvalue (IF nentselflag
(NENTSEL Promptmsg)
(ENTSEL Promptmsg)
)
)
(COND
((= (GETVAR "ERRNO") 52) ; enter
;; skip out
(SETQ pickok T)
)
((= (GETVAR "ERRNO") 7)
(PRINC "Nothing found at selectedpoint. ")
)
((AND (SETQ tmp (ENTGET (CAR returnvalue))) ; object type
typelist
(NOT (MEMBER (CDR (ASSOC 0 tmp))
(MAPCAR 'STRCASE typelist)
)
)
) ; wrong type
(ALERT
(STRCAT
"Selected object is not"
"\na "
(APPLY
'STRCAT
(CONS (CAR typelist)
(MAPCAR '(LAMBDA (x) (STRCAT "\nor " x))
(CDR typelist)
)
)
)
". "
)
)
)
;; skip out
((SETQ pickok T))
)
)
returnvalue
)
;;;------------------------------------------------------------------
edit:
revised as noted.
-
Wow....it's great, I like that.
Sortof Like this ??
-
Thanks Adesu,
that was fun to build
.. Should work with lines and Plines ...
-
Kerry ... im try ur lisp but have error like this
Command: test
Select Top line at start end :
Select Bottom line : Symbol spacing (Top Length is 3.7307) : Specify second
point: ; error: bad argument type: numberp: nil
im used autodesk map 2004
-
Revised . I was clumsy.
;;(POLAR insertPoint (+ g:setoutAngle (* PI 1.5)) 1) <<-- kwb
(POLAR insertPoint (+ setoutAngle (* PI 1.5)) 1)
-
Wow! that's nice Kerry.
About those function names kdub:getass
:-D
-
Dan,
yep, like some others here, I enjoy my code .. :wink:
-
Nice one Kerry, I slept through the whole thing. :-)
-
Very nice KB.
-
Nice one Kerry, I slept through the whole thing. :-)
funny, that usually happens to me .. :-)
-
very nice lisp..to me it's rare lisp.very thank you..