Hallo Proxy,
ich habe das Programm einmal abgeändert, sodaß es auch mit LWPOLYLINE's zurechtkommt. Mit den alten POLYLINE's funktionierte es vorher schon.
Ich hoffe es hilft dir weiter.
Gruß
Helmut
;;;Inserts a vertex in a polyline. If a line is selected, it offers to convert
;;;it to a polyline and then insert the vertex.
;;;Will report: At least one break point must be on polyline. if the end of
;;;a polyline is chosen
;;; Modifiziert und übersetzt für den ZVO
;;; am 30.05.2002 by Marc Scherer
;;;***************************************************************************
(defun C:ADVERT (/
OB OC OO OH
POLYLINE POLYNAME PICKPOINT POLYDXF ENTTYPE
LASTENT NEWVERT OLDERR ANSWER
)
(princ
"\nKontrollpunkt in Polylinie einfügen und neu positionieren..."
) ;_ end princ
(defun MC_ERR (MSG)
(princ
(strcat "\nFehler, Acad meldet: \"" MSG "\" als Ursache!")
) ;_ end princ
(setvar "OSMODE" OO)
(setvar "BLIPMODE" OB)
(setvar "HIGHLIGHT" OH)
(setvar "CMDECHO" OC)
(setq *ERROR* OLDERR
MC_ERR NIL
OLDERR NIL
) ;_ end setq
(princ)
) ;_ end defun
;_ *set all env variables,
;_ *osmode to avoid conflicts with the osnap
;_ *blipmode to make her pretty
(setq OO (getvar "OSMODE")
OB (getvar "BLIPMODE")
OH (getvar "HIGHLIGHT")
OC (getvar "CMDECHO")
OLDERR *ERROR*
*ERROR* MC_ERR
) ;_ end setq
;_ *vertext insert routine
(setvar "OSMODE" 0)
(setvar "BLIPMODE" 0)
(setvar "HIGHLIGHT" 0)
(setvar "CMDECHO" 0)
(while (setq POLYLINE
(entsel
"\nPolylinie anklicken wo ein Kontrollpunkt erzeugt werden soll: (R.klick=Ende)"
) ;_ end entsel
) ;_ end setq
(setq POLYNAME (car POLYLINE)
PICKPOINT (osnap (cadr POLYLINE) "_nea")
POLYDXF (entget POLYNAME)
ENTTYPE (cdr (assoc 0 POLYDXF))
) ;_ end setq
(if (wcmatch ENTTYPE "*POLYLINE")
(INSERTVERT)
(if (= ENTTYPE "LINE")
(progn
(initget "Ja Nein")
(setq ANSWER
(getkword
(strcat
"\n>>>>>>>>>>>>>>>>>> Linie gewählt! <<<<<<<<<<<<<<<<<<<<<<<<<<<<"
"\nSoll diese Linie zur Polylinie gemacht werden? [Ja/Nein] <Ja> "
) ;_ end strcat
) ;_ end getkword
) ;_ end setq
(if (not ANSWER)
(setq ANSWER "Ja")
) ;_ end if
(cond
((= ANSWER "Nein")
(princ "\nLinie nicht in Polylinie konvertiert!")
)
(t
;_ *turn current line into a polyline
(command "_.pedit" POLYNAME "_y" "")
(INSERTVERT)
)
) ;_ end cond
) ;_ progn
(princ
"\nDas gewählte Objekt war keine Polyline oder Linie."
) ;_ end princ
) ;_ if
) ;_ if
) ;_ while
(setvar "OSMODE" OO)
(setvar "BLIPMODE" OB)
(setvar "HIGHLIGHT" OH)
(setvar "CMDECHO" OC)
(setq *ERROR* OLDERR)
(princ)
) ;_ end advert.lsp
(defun INSERTVERT ()
;_ *ensure that last entity is not a compound entity
;_ *by creating a simple temporary entity as the last entity in the
;_ *database this way we can be sure that the next two entities
;_ *will be the two new polylines created by breaking the current
;_ *polyline
(entmake (list '(0 . "POINT") (cons 10 (getvar "VSMIN"))))
(setq LASTENT (entlast))
;_ *breaks polyline at pickpoint
(command "_.break" POLYNAME PICKPOINT PICKPOINT)
;_ *(entnext lastent) will be the next polyline created after lastent
;_ *(entlast) will be the other polyline created
;_ *so now join the two and we have a polyline with the new vertex
;_ *inserted
(cond ((equal ENTTYPE "POLYLINE")
(command "_.PEDIT"(entnext LASTENT)"_join"(entlast)"""_exit") ;_ end command
;_ *get rid of temporary point
(entdel LASTENT)
)
((equal ENTTYPE "LWPOLYLINE")
(command "_.PEDIT" POLYNAME "_join"(entlast)"""_exit") ;_ end command
;_ *get rid of temporary point
(entdel LASTENT)
)
);cond
(princ "\nBitte den neuen Kontrollpunkt positionieren: ")
(setq NEWVERT (osnap PICKPOINT "_int,_near"))
(command "_.STRETCH" "_C" NEWVERT NEWVERT "" PICKPOINT PAUSE) ;_ end command
;_ end command
;_ end COMMAND
) ;_ end defun
(princ)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
Thema geschlossen!
| 
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?" Read the whole story: 
