help for a lisp

Discussion of other Lisp dialects (Arc, Clojure, AutoLisp, XLISP, etc.)

help for a lisp

Postby fox0007773 » Tue Apr 27, 2010 3:36 pm

When i try to use my lisp, autocad says ; error: no function definition: VLAX-ENAME->VLA-OBJECT
its a lisp to reverse the directions of lines and plines.
Here is the code so if someone can help me i would appreciate it.
Thanks

(defun C:MINV()

(cleanvar_minv)
(princ "\n---> Sélectionner les lignes à inverser :")
(setq Line_ss (ssget))

(setq #z 0)
(while (< #z (sslength Line_ss))

(if (not
(vl-position
(vlax-get
(vlax-ename->vla-object
(ssname Line_ss #z)) 'ObjectName) '("AcDbLine" "AcDbPolyline" "AcDb2dPolyline" ))
);not
(ssdel (ssname Line_ss #z) Line_ss)
)
(setq #z (1+ #z))
);repeat

(setq #z 0)
(while (< #z (sslength Line_ss))
(setq l_name (ssname Line_ss #z))
(inverser)
(setq #z (1+ #z))
);repeat

(cleanvar_minv)
(princ "\n Inversion des lignes réussies. Support DAO 2009.")
(princ)

);defun

(defun cleanvar_minv()

(setq a nil
aa nil
coin nil
#rep nil
#seq nil
#coin nil
#bulge nil
#seq1 nil
#Z nil
Line_ss nil
l_name nil
)
(princ)

);defun



(DEFUN INVERSER ()

(SETQ #PLI '() COIN '() #REP "NON" AA '() #SEQ '() #COIN '() #BULGE '() #SEQ1 '())

(SETQ A (ENTGET l_name))
(IF (OR (= (CDR (ASSOC 0 A)) "LINE")(= (CDR (ASSOC 0 A)) "POLYLINE"))
(PROGN
(IF (= (CDR (ASSOC 0 A)) "LINE")
(PROGN
(SETQ #REP "OUI")
(SETQ #PT1 (CDR (ASSOC 10 A)))
(SETQ #PT2 (CDR (ASSOC 11 A)))
(SETQ A (SUBST (CONS 10 #PT2) (ASSOC 10 A) A))
(SETQ A (SUBST (CONS 11 #PT1) (ASSOC 11 A) A))
(ENTMOD A)
;;; (PROMPT "\nOpération terminée ....")
(PRINC)
)
(PROGN
(SETQ #CLOSE (CDR (ASSOC 70 A)))
(COND
((= #CLOSE 0)(SETQ #REP "OUI"))
((= #CLOSE 1)(SETQ #REP "OUI"))
((= #CLOSE 8)(SETQ #REP "OUI"))
((= #CLOSE 9)(SETQ #REP "OUI"))
((= #CLOSE 128)(SETQ #REP "OUI"))
((= #CLOSE 129)(SETQ #REP "OUI"))
(T)
)
(SETQ #PLI (CONS A #PLI))
(WHILE (/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDR (ASSOC -1 A)))))) "SEQEND")
(SETQ A (ENTGET (ENTNEXT (CDR (ASSOC -1 A)))))
(SETQ #PT1 (CDR (ASSOC 10 A)))
(SETQ #C42 (CDR (ASSOC 42 A)))
(IF (/= #C42 0.0)
(SETQ #C42 (* #C42 -1.0))
)
(SETQ #PLI (CONS A #PLI) COIN (CONS #PT1 COIN) #BULGE (CONS #C42 #BULGE))
)
(SETQ A (ENTGET (ENTNEXT (CDR (ASSOC -1 A)))))
(SETQ #PLI (CONS A #PLI))
(SETQ #PLI (REVERSE #PLI))
(IF (OR (= #CLOSE 0)(= #CLOSE 128)(= #CLOSE 8))
(PROGN
(SETQ COIN (REVERSE COIN))
(SETQ COIN (CONS "0" COIN))
(SETQ COIN (REVERSE COIN))
(SETQ #BULGE (REVERSE #BULGE))
(SETQ #BULGE (CONS #C42 #BULGE))
(SETQ #BULGE (REVERSE #BULGE))
)
(PROGN
(SETQ COIN (CONS (LAST COIN) COIN))
(SETQ #BULGE (CONS "0" #BULGE))
)
)
(IF (= #REP "OUI")
(PROGN
(SETQ N 0 M 1)
(REPEAT (- (LENGTH COIN) 1)
(SETQ #NN (NTH (+ N 1) #PLI))
(SETQ #NN (SUBST (CONS 10 (NTH N COIN)) (ASSOC 10 #NN) #NN))
(SETQ #NN (SUBST (CONS 42 (NTH M #BULGE)) (ASSOC 42 #NN) #NN))
(SETQ #PLI (SUBST #NN (NTH (+ N 1) #PLI) #PLI))
(SETQ N (+ N 1) M (+ M 1))
)
(SETQ N 0)
(REPEAT (LENGTH #PLI)
(ENTMOD (NTH N #PLI))
(SETQ N (+ N 1))
)
(ENTUPD (CDR (ASSOC -1 (NTH 0 #PLI))))
;;; (PROMPT "\nOperation terminee ....")
(PRINC)
)
)
)
)
)
(PROGN
(IF (= (CDR (ASSOC 0 A)) "LWPOLYLINE")
(PROGN
(SETQ N 0 #REP "OUI")
(REPEAT (LENGTH A)
(SETQ SS1 (NTH N A))
(IF (= (CAR SS1) 10)
(PROGN
(SETQ #PLI (CONS (CDR SS1) #PLI))
(SETQ #SEQ (CONS N #SEQ))
)
)
(IF (= (CAR SS1) 42)
(PROGN
(SETQ #C42 (CDR SS1))
(IF (/= #C42 0.0)
(SETQ #C42 (* #C42 -1.0))
)
(SETQ #BULGE (CONS #C42 #BULGE))
(SETQ #SEQ1 (CONS N #SEQ1))
)
)
(SETQ N (+ N 1))
)
(IF (= #REP "OUI")
(PROGN
(IF (OR (= (CDR (ASSOC 70 A)) 0)(= (CDR (ASSOC 70 A)) 128))
(PROGN
(SETQ #PLI (REVERSE #PLI))
(SETQ #PLI (CONS "0" #PLI))
(SETQ #SEQ (CONS "0" #SEQ))
(SETQ #BULGE (REVERSE #BULGE) #SEQ1 (REVERSE #SEQ1))
(SETQ #BULGE (CONS #C42 #BULGE) #SEQ1 (CONS (LAST #SEQ1) #SEQ1))
(SETQ #BULGE (REVERSE #BULGE))
)
(PROGN
(SETQ #PLI (CONS (LAST #PLI) #PLI))
(SETQ #SEQ (CONS (LAST #SEQ) #SEQ))
(SETQ #PLI (REVERSE #PLI))
(SETQ #BULGE (REVERSE #BULGE))
(SETQ #BULGE (CONS "0" #BULGE))
(SETQ #SEQ1 (CONS "0" #SEQ1))
)
)
(SETQ N 1)
(REPEAT (- (LENGTH #SEQ) 1)
(SETQ #COIN (CONS (LIST (NTH N #SEQ) (CONS 10 (NTH N #PLI))) #COIN))
(SETQ N (+ N 1))
)
(SETQ N 1)
(REPEAT (- (LENGTH #SEQ1) 1)
(SETQ #COIN (CONS (LIST (NTH N #SEQ1) (CONS 42 (NTH N #BULGE))) #COIN))
(SETQ N (+ N 1))
)
(SETQ N 0)
(REPEAT (LENGTH A)
(SETQ NNN (CAR (CDR (ASSOC N #COIN))))
(IF (/= NNN NIL)
(SETQ AA (CONS NNN AA))
(SETQ AA (CONS (NTH N A) AA))
)
(SETQ N (+ N 1))
)
(SETQ AA (REVERSE AA))
(ENTMOD AA)
)
)
)
)
)
)
)
fox0007773
 
Posts: 1
Joined: Tue Apr 27, 2010 3:32 pm

Re: help for a lisp

Postby kipianid » Wed Dec 01, 2010 7:55 am

Try this one,

; process LINE
(defun do_line (e / ent pt1 pt2 item)
(setq ent (entget e))
(foreach item ent
(cond
((= (car item) 10)
(setq pt1 (cdr item))
)
((= (car item) 11)
(setq pt2 (cdr item))
)
)
)
(setq ent (subst (cons 10 pt2)(assoc 10 ent) ent))
(setq ent (subst (cons 11 pt1)(assoc 11 ent) ent))
;(PRINT ent)
(if (entmod ent)
(progn
(prompt "DONE ")
(entupd e)
)
(prompt " failed!")
)
)

; process old POLY
(defun do_heavy (e / e1 ent0 ent ent1 list_new list_of_vert bulge)
(setq e1 e
ent0 (entget e1)
e (entnext e)
ent1 (entget e)
bulge (cdr (assoc 42 ent1))
e (entnext e)
ent (entget e); skip header
)
(while (= (cdr (assoc 0 ent)) "VERTEX")
(setq list_new (subst (cons 42 (- bulge))(assoc 42 ent) ent)
bulge (cdr (assoc 42 ent))
list_of_vert (cons list_new list_of_vert)
e (entnext e)
ent (entget e)
)
)
(entmake ent0)
(foreach ent list_of_vert (entmake ent))
(entmake (subst (cons 42 (- bulge))(assoc 42 ent1) ent1))
(if (entmake ent)
(progn
(prompt "DONE ")
(entdel e1)
(redraw (entlast))
)
(prompt " failed!")
)
)

; process new POLY
(defun do_light (e / hdr tail list_new list_of_vert)
(foreach item (reverse (entget e))
(cond
((and (not hdr)(= (car item) 10))
(setq hdr item)
)
((member (car item) '(10 40 41))
(setq list_of_vert (cons item list_of_vert))
)
((= (car item) 42)
(setq list_of_vert (cons (cons 42 (- (cdr item))) list_of_vert))
)
((= (car item) 210)
(setq tail item)
)
(T (setq list_new (cons item list_new)))
)
)
(if (entmod (append list_new (list hdr)(reverse list_of_vert)(list tail)))
(progn
(prompt "DONE ")
(entupd e)
)
(prompt " failed!")
)
)

(defun C:reverseline ( / ocmde e etyp ans)
(setq ocmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (setq e (car (entsel "\nSelect a lines or polylines: ")))
(setq etyp (cdr (assoc 0 (entget e))))
(cond
((= etyp "LINE")(do_line e))
((= etyp "POLYLINE")(do_heavy e))
((= etyp "LWPOLYLINE")(do_light e))
(T (prompt (strcat " selected " etyp)))
)
)
(setvar "cmdecho" ocmde)
(prin1)
)

(defun C:reverseline ( / ocmde e etyp ans ss ssl i)
(setq ocmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nSelect a lines or polylines: ")
(setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
(if ss (progn
(setq ssl (sslength ss) i 0)
(while (< i ssl)
(setq e (ssname ss i))
(setq etyp (cdr (assoc 0 (entget e))))
(cond
((= etyp "LINE")(do_line e))
((= etyp "POLYLINE")(do_heavy e))
((= etyp "LWPOLYLINE")(do_light e))
(T (prompt (strcat " selected " etyp)))
)
(setq i (1+ i))
)
));if progn
(setvar "cmdecho" ocmde)
(prin1)
)

(prin1)
(princ "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
(princ "\n ~~Innsbruck 2010~~ ")
(princ "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
(princ "\nBefehl: Aufruf/Command: reverseline ")
(princ)
kipianid
 
Posts: 2
Joined: Thu Nov 11, 2010 1:37 am


Return to Other Dialects

Who is online

Users browsing this forum: No registered users and 0 guests