TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: lispman21 on August 02, 2006, 08:43:49 AM
-
Here is code to convert circles to plines, but after the program runs the pline conversions are not placed where the original circles where. Is there a way to get the original origin of the circles and then make them plines and move the plines back where they should be.
(defun C2P (/ OLDVAR1 COUNT LINENO SS1 ename elist pt )
(alert "\nConverting Circles to PLines\n")
(command ".undo" "Mark")
(setq OLDVAR1 (getvar "CMDECHO")) (setvar "CMDECHO" 0)
(setq SS1 nil)
(setq SS1 (ssget "X" ' ((0 . "CIRCLE"))))
(setq LINENO (sslength SS1))
(setq COUNT 0)
(setq PLINFO (ssadd))
(repeat LINENO
(progn
(setq ename (ssname SS1 COUNT))
(setq elist (entget ename))
(setq dia (* 2 (cdr (assoc 40 elist)))) ;get diameter
(setq pt (cdr (assoc 10 elist))) ;get center point
(setq lay (cdr (assoc 8 elist))) ;get layer
(command "donut" dia dia pt "") ;make the donut
(setq ename (entlast)) ;move donut to circle's layer
(setq elist (entget ename))
(setq elist (subst (cons 8 lay) (assoc 8 elist) elist))
(entmod elist)
(setq COUNT (1+ COUNT))
)
)
(COMMAND "ERASE" SS1 "")
(setvar "CMDECHO" OLDVAR1)
(prompt (strcat "\n" "Erasing original Circles..." "\n"))
(princ) ; end program
(terpri)
); end convert.lsp
-
Could be an osnap problem.
(command "donut" dia dia "non" pt "") ;make the donut
Could be a UCS problem.
(command "donut" dia dia "non" (trans pt 1 0) "") ;make the donut
-
(defun C:C>LW (/ C D SS)
;(C:C>LW)
(if (setq ss (ssget "_X" '((0 . "CIRCLE"))))
(foreach e (mapcar
(function entget)
(vl-remove-if
(function listp)
(mapcar
(function cadr) (ssnamex ss))
) ;_ vl-remove-if
) ;_ mapcar
(entmakex
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(assoc 8 e)
(if (assoc 62 e)
(assoc 62 e)
'(62 . 256)
) ;_ if
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(list 10 (+ (car (setq c (cdr (assoc 10 e)))) (setq d (cdr (assoc 40 e))))(cadr c))
'(42 . 0.4142135623730951)
(list 10 (car c) (+ (cadr c) d))
'(42 . 0.4142135623730951)
(list 10 (- (car c) d) (cadr c))
'(42 . 0.4142135623730951)
(list 10 (car c) (- (cadr c) d))
'(42 . 0.4142135623730951)
) ;_ list
) ;_ entmakex
(entdel (cdr(assoc -1 e)))
) ;_ foreach
) ;_ if
) ;_ defun
(defun C:LW>C (/ P1 P2 SS)
;(C:LW>C)
(if (setq ss (ssget "_X"
'((0 . "LWPOLYLINE")
(90 . 4)
(70 . 1)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
)
) ;_ ssget
) ;_ setq
(foreach e (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
(entmakex
(list
'(0 . "CIRCLE")
(assoc 8 (entget e))
(if (assoc 62 (entget e)) (assoc 62 (entget e)) '(62 . 256))
(cons 10
(setq
p1 (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.)))
(setq p2 (vlax-curve-getPointAtParam e 0))
(vlax-curve-getPointAtParam e 2)
) ;_ mapcar
) ;_ setq
) ;_ cons
(cons 40 (distance p1 p2))
) ;_ list
) ;_ entmakex
(entdel e)
) ;_ foreach
) ;_ if
) ;_ defun
-
Tried both instances but neither worked but somethign must be really messed up.
-
A drawing is attached and the code doesn't work right in this drawing.
-
Probably, it is better to make a polyline with two points.
I have shown my old program, adapted for a forum...
My code, only for UCS World and normal 0 0 1
-
Here is something, see if works.
(if (not dwg)
(setq dwg (vla-get-activedocument (vlax-get-acad-object))))
(defun 2dpt (pt)
(if (caddr pt)
(list (car pt) (cadr pt))
pt))
(defun activespace ()
(if (= acmodelspace (vla-get-activespace dwg))
(vla-get-modelspace dwg)
(if (= (vla-get-mspace dwg) :vlax-true)
(vla-get-modelspace dwg)
(vla-get-paperspace dwg))))
(defun variantarray (ptslist / arrayspace sarray)
(setq arrayspace
(vlax-make-safeArray
vlax-vbDouble
(cons 0
(- (length ptslist) 1))))
(setq sarray (vlax-safeArray-fill arrayspace ptslist))
(vlax-make-variant sarray))
(defun getbulge (p1 midp p2 / ang chord midc alt)
(setq ang (angle p1 p2)
chord (distance p1 p2)
midc (polar p1 ang (* chord 0.5))
alt (distance midp midc))
(cond
((zerop chord) 0.0)
((equal (angle midp midc)
(rem (+ ang (* pi 0.5)) (* pi 2))
1e-4)
(/ alt chord 0.5))
(t (/ alt chord -0.5))))
(defun poner_color (obj color_use)
(if (wcmatch (getvar "acadver") "16*")
(setq vla_truecolor
(vla-getinterfaceobject
(vlax-get-acad-object)
"AutoCAD.AcCmColor.16")))
(if (wcmatch (getvar "acadver") "16*")
(progn
(vla-put-colorindex
vla_truecolor
color_use)
(if obj
(vla-put-truecolor obj vla_truecolor)))
(if (wcmatch (getvar "acadver") "15*")
(vla-put-color obj color_use)))
(vlax-release-object vla_truecolor)
(setq vla_truecolor nil))
(defun circ_poly (obj / ctr radio a b c d pts vla_poly color_use)
(if (wcmatch (getvar "acadver") "16*")
(setq color_use (vla-get-colorindex (vla-get-truecolor obj))))
(if (wcmatch (getvar "acadver") "15*")
(setq color_use (vla-get-color obj)))
(setq ctr (vlax-get obj 'center)
radio (vlax-get obj 'radius)
a (polar ctr pi radio)
b (polar ctr 0.0 radio)
c (polar ctr (* pi 0.5) radio)
d (polar ctr (* pi 1.5) radio)
pts (mapcar '2dpt (list a b)))
(if (not (vl-catch-all-error-p
(setq vla_poly
(vl-catch-all-apply
'vla-addlightweightpolyline
(list (activespace)
(variantarray (apply 'append pts)))))))
(vla-put-closed vla_poly t))
(vla-setbulge
vla_poly
0
(getbulge a c b))
(vla-setbulge
vla_poly
1
(getbulge b d a))
(poner_color vla_poly color_use)
vla_poly)
(defun C:C2P (/ ename)
(if (and (setq ename (car (entsel "\nSelect circle: ")))
(circ_poly (vlax-ename->vla-object ename)))
(entdel ename))
(princ))
(princ)
-
A drawing is attached and the code doesn't work right in this drawing.
Only for your file
(defun C:C>LW (/ C D SS)
;(C:C>LW)
(if (setq ss (ssget "_X" '((0 . "CIRCLE"))))
(foreach e (mapcar
(function entget)
(vl-remove-if
(function listp)
(mapcar
(function cadr) (ssnamex ss))
) ;_ vl-remove-if
) ;_ mapcar
(entmakex
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(assoc 8 e)
(if (assoc 62 e)
(assoc 62 e)
'(62 . 256)
) ;_ if
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(list 10 (+ (car (setq c (cdr (assoc 10 e)))) (setq d (cdr (assoc 40 e))))(cadr c))
'(42 . 0.4142135623730951)
(list 10 (car c) (+ (cadr c) d))
'(42 . 0.4142135623730951)
(list 10 (- (car c) d) (cadr c))
'(42 . 0.4142135623730951)
(list 10 (car c) (- (cadr c) d))
'(42 . 0.4142135623730951)
(assoc 210 e)
) ;_ list
) ;_ entmakex
(entdel (cdr(assoc -1 e)))
) ;_ foreach
) ;_ if
) ;_ defun
(defun C:LW>C (/ P1 P2 SS)
;(C:LW>C)
(if (setq ss (ssget "_X"
'((0 . "LWPOLYLINE")
(90 . 4)
(70 . 1)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
(42 . 0.4142135623730951)
)
) ;_ ssget
) ;_ setq
(foreach e (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
(entmakex
(list
'(0 . "CIRCLE")
(assoc 8 (entget e))
(if (assoc 62 (entget e)) (assoc 62 (entget e)) '(62 . 256))
(cons 10
(setq
p1 (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.)))
(setq p2 (vlax-curve-getPointAtParam e 0))
(vlax-curve-getPointAtParam e 2)
) ;_ mapcar
) ;_ setq
) ;_ cons
(cons 40 (distance p1 p2))
) ;_ list
) ;_ entmakex
(entdel e)
) ;_ foreach
) ;_ if
) ;_ defun
-
OK, Both of the previous codes worked exactly like I wanted them too. Although Esquivel's code did not automatically select the circles it required user input. Which really isn't that big of a change, just what I was looking for. Thanks Everyone.
-
lispman21
Sorry I did not have more time before.
I see you got help before I could get back.
There were several errors in your code and when corrected it did work.
(defun c2p (/ oldvar1 ss1 ename elist pt dia lay)
(alert "\nConverting Circles to PLines\n")
(command ".undo" "Mark")
(setq oldvar1 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss1 (ssget "X" '((0 . "CIRCLE"))))
(setq i -1)
(while (setq ename (ssname ss1 (setq i (1+ i))))
(setq elist (entget ename))
(setq dia (* 2 (cdr (assoc 40 elist))))
(setq pt (cdr (assoc 10 elist)))
(setq lay (cdr (assoc 8 elist)))
(command "donut" dia dia "non" (trans pt ename 0) "")
(setq elist (entget (entlast)))
(entmod (subst (cons 8 lay) (assoc 8 elist) elist))
)
(command "ERASE" ss1 "")
(setvar "CMDECHO" oldvar1)
(prompt (strcat "\n" "Erasing original Circles..." "\n"))
(princ)
)
<edit: added trans>
-
O/T:
(defun IsEsquivelAlias ( memberName )
(member (strcase memberName)
'(
"ESQUIVEL"
"LE"
"LUIS ESQUIVEL"
"LUIS"
"ROBERT ZIMMERMAN"
"ZIMMERMAN"
)
)
)
Just tryin' to keep up.
-
O/T:
(defun IsEsquivelAlias ( memberName )
(member (strcase memberName)
'(
"ESQUIVEL"
"LE"
"LUIS ESQUIVEL"
"LUIS"
"ROBERT ZIMMERMAN"
"ZIMMERMAN"
)
)
)
Just tryin' to keep up.
He he.... none of them is my real name :roll:
-
How's this?
(defun IsJoseRodriguezAlias ( memberName )
(member (strcase memberName)
'(
"ESQUIVEL"
"LE"
"LUIS ESQUIVEL"
"LUIS"
"ROBERT ZIMMERMAN"
"ZIMMERMAN"
)
)
)
-
(defun IsJoseRodriguezAlias ( memberName )
(member (strcase memberName)
'(
"ESQUIVEL"
"LE"
"LUIS ESQUIVEL"
"LUIS"
"ROBERT ZIMMERMAN"
"ZIMMERMAN"
)
)
)
:lmao:
-
Aha.... so we have spy's here that work undercover for the swamp?..... (nope, Jose Rodriguez is one of my best friends (he is from Texas) and lives now here in SD. - the PC I used here in my office still have his setup, when he was working here...)
As many, that do not want to say their real names... I'll kept Luis Esquivel.... :kewl:
-
As many, that do not want to say their real names...
I have a pen name, but I'm not giving it up. You'll all just have to be happy with my real name! :-)
-
As many, that do not want to say their real names...
I have a pen name, but I'm not giving it up. You'll all just have to be happy with my real name! :-)
hehehe .. me too. If I was inventing a name it would be Bob something I think ..
I thought Luis changed his signin name each day to match his Tshirt ... is this not the case ?
-
I thought Luis changed his signin name each day to match his Tshirt ... is this not the case ?
Wow; :-o - good guess, man.... :kewl: