Author Topic: Help update this LISP from Luis Please...  (Read 5366 times)

0 Members and 1 Guest are viewing this topic.

uncoolperson

  • King Gator
  • Posts: 4430
  • Doing everything in metric inches!
Re: Help update this LISP from Luis Please...
« Reply #15 on: November 13, 2010, 01:00:14 AM »
The prevailing thought about AutoLISP( in regards to the class) is that AutoCAD already does the things that LISP can do so there's no need to program yourself anymore.

I thought the only reason we got lost in these parentheses is because we want autocad to do stuff it won't normally do.

+1 vote for fool
when all else fails On Error Resume Next
-----------------------
Livin like I'm on borrowed time
-----------------------
Searching for the Ballmer Peak

MSTG007

  • Water Moccasin
  • Posts: 2397
  • I can't remeber what I already asked! I need help!
Re: Help update this LISP from Luis Please...
« Reply #16 on: June 13, 2017, 08:21:59 AM »
Here's a quick fix for 2dpolylines  8-):

Code: [Select]
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
  (if (and fromvertex p2)
    (progn (setq a1 (angle cen fromvertex)
a2 (angle cen p2)
   )
   (if (or (< a1 a2) (equal a1 a2 0.001))
     (setq d (* r (- a2 a1)))
     (setq d (* r (- (+ 6.2831853 a2) a1)))
   )
    )
    ;; es un circulo
    (setq d (* r 6.2831853))
  )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
  (setq dir   (cond ((minusp bulge) -1.0)
    (t 1.0)
      )
theta (* 4.0 (atan (abs bulge)))
  )
  (if (> theta pi)
    (setq theta (- (* 2.0 pi) theta)
  dir (* -1.0 dir)
    )
  )
  (setq theta (/ theta 2.0)
radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
pc    (polar fromvertex beta radio)
  )
  (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
       (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
  (setq closed (vla-get-closed vla_poly))
  (setq endparam (vlax-curve-getendparam vla_poly))
  (setq param endparam)
  (setq i 0)
  (while (> param 0)
    (setq param (1- param))
    (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
    (if (vlax-property-available-p vla_poly 'bulge)
      (setq bulge (vla-getbulge vla_poly (fix i)))
    )
    (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
    (setq dis (distance fromvertex nextvertex))
    (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
    (if (and bulge (not (zerop bulge)))
      (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
     (setq etype "ARC")
      )
      (progn bulge (setq etype "LINE"))
    )
;;;;;;    (if (not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
    (setq vlist (cons (list ;; numero vertice
    (+ i 1)
    ;; tipo de objeto
    etype
    ;; punto medio
    midpt
    ;; inicia vertice
    fromvertex
    ;; termina vertice
    nextvertex
    ;; longitud de curva o recta
;;;;;;        (if (= eType "ARC")
;;;;;; (strcat
;;;;;;    :rcmPrefixArcText
;;;;;;    (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;; ;; es una recta
;;;;;; (rtos dis (rcmd-getUnits-mode) :rcmPrec))
      )
      vlist
)
    )
    (setq i (1+ i))
  )
  (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
  ;; establecer longitud de flecha de acuerdo a la altura de pantalla
  ;; para dibujar las flechas iguales a cualquier nivel de zoom
  (setq unidad (/ (getvar "VIEWSIZE") 15))
  (foreach dat lst_dat
    (setq angf (cadr dat)
  dirf (caddr dat)
  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
  pf2  (polar pfm angf (/ unidad 2.0))
    )
    (if (= dirf 1)
      (setq pf3 (polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
    pf4 (polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
      )
      (setq pftemp pf1
    pf1    pf2
    pf2    pftemp
    pf3    (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
    pf4    (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
      )
    )
    (if flag_dir
      (progn ;; dibujar flecha color verde
     ;; cuando se le cambie de direccion
     (grdraw pf1 pf2 3)
     (grdraw pf2 pf3 3)
     (grdraw pf2 pf4 3)
      )
      (progn ;; dibujar flecha
     (grdraw pf1 pf2 4)
     (grdraw pf2 pf3 4)
     (grdraw pf2 pf4 4)
      )
    )
  )
  (setq flag_dir nil)
)

;;; Command for test...
(defun c:tst (/ pol obj pol_data)
  (setq pol (car (entsel "\nSelect polyline: "))
obj (vlax-ename->vla-object pol)
pol_data (getlwpolydata obj)
  )
  (dib_flechdir
    (setq lst_dat
   (vl-remove
     nil
     (mapcar (function (lambda (i)
(if (nth 2 i)
   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
)
       )
     )
     pol_data
     )
   )
    )
  )
  (princ)
)

Sorry to bring this topic back up. With the routine how hard would it be to add the reverse command into it? Its awesome that it shows the direction of the entity!
Autodesk Infrastructure Design Suite 2019

cmwade77

  • Swamp Rat
  • Posts: 1206
Re: Help update this LISP from Luis Please...
« Reply #17 on: June 19, 2017, 01:21:12 PM »
The prevailing thought about AutoLISP( in regards to the class) is that AutoCAD already does the things that LISP can do so there's no need to program yourself anymore.

I humbly submit that your instructor is a fool, he should not be "teaching" and you can him I said that (although that may not be a good strategy for you as he may "punish" you in his marking etc).
I have to agree with this statement.