Lisp van 2008 werkt niet meer (opgelost)

[Sven]

Hoi,

Ik heb een lisp die gemaakt is voor Autocad 2009. Na vele jaren hebben we deze terug nodig, maar het werkt niet meer in Autocad 2018 en nieuwer. Is er iemand die weet waaraan dit ligt? Alvast bedankt.

;; Function C:DWGStar is the main program function and defines the AutoCAD DWGStar command.
(defun C:DWGStar ()
;;get all 3Dpolylines
(if    (setq all3Dpolylines (dwgstar:get3DPolylines)
         N1 0
         Aantal_all3Dpolylines (sslength all3Dpolylines)
   )
     (while (< N1 Aantal_all3Dpolylines)
      (setq polyline (ssname all3Dpolylines N1))
        (if (= (dwgstar:checkver polyline) T)
        (progn
         (setq vertices (dwgstar:getver polyline))
           (dwgstar:create3dPoly vertices polyline)
           (command "erase" polyline "")
        )
      )
      (setq N1 (1+ N1))
   )
   (princ "\nNo 3Dpolylines found.")
) ;_ end of if
(princ) ; exit quietly
);_ end of defun

;;; Display a message to let the user know the command name.
(princ "\nType dwgstar to clean up the drawing.")
(princ)


;;; Function dwgstar:get3DPolylines will get all the 3Dpolylines
(defun dwgstar:get3DPolylines (/ StartPt EndPt HalfWidth)
  (setq ss (ssget "x" (list (cons 0 "POLYLINE"))))
) ;_ end of dwgstar:get3DPolylines

;;; Function dwgstar:create3dPoly will create a new 3D polyline
(defun dwgstar:create3dPoly (vertices polyline)
   (setq layer (cdr (assoc 8 (entget polyline))))
     (command "clayer" layer)
     (setq color (cdr (assoc 62 (entget polyline))))
     (command "_color")
   (if (/= color nil)
        (command color)
        (command "ByLayer")
     )

     ;(princ layer)
     ;(princ " ")
     ;(princ color)
     ;(princ "\n")
     (command "3dpoly")                                 ;start 3dpoly command
     (foreach n vertices (command n))
     (if (= (cdr (assoc 70 (entget polyline))) 9)
             (command "close")
             (command "")
     )
) ;_ end of dwgstar:create3dPoly



;;; Function dwgstar:getver will get all the vertices, except the  of the current polyline and put it into a list.
(defun dwgstar:getver (EntNme / stop teller SubEnt VerLst vertex)
(setq SubEnt (entnext EntNme))                     ;get first vertex
;(setq teller 0)
(setq stop 0)
(setq VerLst nil)                                  ;setup vertex list
(while SubEnt
   (if (= (getval 0 SubEnt) "VERTEX") ;do only vertexes
           (progn
         ;(setq teller (1+ teller))
         (if (= (flagsetp 16 SubEnt) nil) ;if true, then this vertex is no spline control point
            (progn
           (setq vertex (cdr (assoc 10 (entget SubEnt))))   ;get first vertex point
              (setq VerLst (append VerLst (list vertex)))      ;add vertex to verlst
         )
      
         )
      )
           (setq stop T)
   )
   (if(/= stop T)
     (setq SubEnt (entnext SubEnt))                   ;go to next vertex
     (setq SubEnt nil)
   )
)
;(princ teller)
VerLst                                             ;return vertex list
);_ end of dwgstar:getver

;;; Function dwgstar:checkver will get all the vertices, return true if there is a spline control point that should be cleaned
(defun dwgstar:checkver (EntNme / stop teller SubEnt Cleanup vertex)
(setq SubEnt (entnext EntNme))            ;get first vertex
;(setq teller 0)
(setq stop 0)
(setq Cleanup 0)               ;setup vertex list
(while SubEnt
   (if (= (getval 0 SubEnt) "VERTEX")          ;do only vertexes
           (progn
         ;(setq teller (1+ teller))
         (if (/= (flagsetp 16 SubEnt) nil)    ;if true, then this vertex is a spline control point
            (setq Cleanup T)      
         )
      )
           (setq stop T)            ; if no vertex, set stop to true
   )
   (if(/= stop T)
     (setq SubEnt (entnext SubEnt))         ; if not stop, go to next vertex
     (setq SubEnt nil)               ; if stop, then end while
   )
)
;(princ teller)
Cleanup                                              ;return Cleanup value
);_ end of dwgstar:checkver


; HELPER functions...
(defun GETVAL (grp ele)                 ;"dxf value" of any ent...
    (cond ((= (type ele) 'ENAME)          ;ENAME
            (cdr (assoc grp (entget ele))))
          ((not ele) nil)                 ;empty value
          ((not (listp ele)) nil)         ;invalid ele
          ((= (type (car ele)) 'ENAME)    ;entsel-list
            (cdr (assoc grp (entget (car ele)))))
          (T (cdr (assoc grp ele)))))     ;entget-list


(defun GETFLAG (ele)
  (getval 70 ele)
)

(defun FLAGSETP (val ele)
    (bitsetp val (getflag ele)))

(defun BITSETP (val flag)
    (= (logand val flag) val)
)

[EddyBeerke]

Krijg je een foutmelding?
Bij mij werkt de lisp zonder fouten in AutoCAD 2020 (Civil 3d).
Wat moet de lisp doen?

[Sven]

Ik krijg geen foutmelding, maar hij doet gewoon niet meer wat hij wel deed.

Het gaat hierbij om een soort splines van een ander programma (STAR) die bij omzetting naar dwg 3d-polylijnen worden. De extra vertices vormen hierbij voor een soort zaagtanden. Deze lisp verwijdert deze extra punten in de 3d-polylijnen zodat ze er weer vloeiend uit zien.

Ik heb een stuk van zo'n tekening hieronder als bijlage gestoken.

[roy_043]

Zo zou ik dit probleem oplossen:

Code Selecteer Uitklappen

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Geom_Angle (pt1 pt2 pt3 / ang)
  (cond
    ((<= (- pi) (setq ang (- (angle pt2 pt3) (angle pt2 pt1))) pi)
      ang
    )
    ((minusp ang)
      (+ ang pi pi)
    )
    (T
      (- ang pi pi)
    )
  )
)

(defun KGA_List_Divide_3 (lst / ret)
  (repeat (/ (length lst) 3)
    (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
    (setq lst (cdddr lst))
  )
  (reverse ret)
)

; (Fix3DPolyZigZag (vlax-ename->vla-object (car (entsel))))
; 2 opeenvolgende scherpe hoeken van 15 graden of kleiner worden als zaagtand beschouwd.
(defun Fix3DPolyZigZag (obj / ptLst tmp)
  (setq ptLst (KGA_List_Divide_3 (vlax-get obj 'coordinates)))
  (setq tmp
    (mapcar
      '(lambda (ptPre ptCur ptAft / ang)
        (cond
          ((not ptPre)
            nil
          )
          ((not ptAft)
            nil
          )
          ((< (/ pi 12.0) (setq ang (abs (KGA_Geom_Angle ptPre ptCur ptAft))))
            nil
          )
          (T
            ang
          )
        )
      )
      (cons nil ptLst)
      ptLst
      (append (cdr ptLst) '(nil))
    )
  )
  (setq ptLst
    (vl-remove
      nil
      (mapcar
        '(lambda (angPre angCur angAft pt)
          (cond
            ((not angCur)
              pt
            )
            ((< angCur angPre)
              nil
            )
            ((< angCur angAft)
              nil
            )
            (T
              pt
            )
          )
        )
        (cons nil tmp)
        tmp
        (append (cdr tmp) '(nil))
        ptLst
      )
    )
  )
  (vlax-put obj 'coordinates (apply 'append ptLst))
)

(defun c:DwgStarNew ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (Fix3DPolyZigZag obj)
    )
  )
  (vla-endundomark doc)
  (princ)
)

Edit: Code iets efficiënter.

[roy_043]

Het is ook aan te raden om _overKill te gebruiken: de 3D polylijnen bevatten segmenten met L=0, en alle elementen zijn 2x gekopieerd.

[Sven]

Bedankt!! Dit werkt perfect.