Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

batter lisp need improvement

0 REPLIES 0
Reply
Message 1 of 1
marlance
539 Views, 0 Replies

batter lisp need improvement

Hi everyone

 

I got this code from cadtutor and tried to modify to suit my needs mostly in civil works.

But still having a problem with it.

For example;

top of batter location (blue line) =on top

bottom batter location (red line) =on bottom

the batter symbol is ok.

 

but when;;;;

top of batter location (blue line) =on bottom

bottom batter location (red line) =on top

the batter symbol is inverted

batter output.PNG

 

here's the output that I want to achieve

 

batter proposed output.PNG

(vl-load-com)
(defun alg-ang (obj pnt)
(- (angle '(0. 0. 0.)(vlax-curve-getfirstderiv obj
       (vlax-curve-getparamatpoint obj pnt)))(/ pi 2)))
 
(defun C:test (/ stepLength endPt startPt divStep)
(COMMAND "_UNDO" "_M")
  (setq acadApp (vlax-get-acad-object))
  (setq acadDoc (vla-get-ActiveDocument acadApp))
  (setq acSp (vla-get-modelspace acadDoc))

(setq a '(0.0 0.0 0.0))
(command "-insert" "tick" "_s" "1" a "0")
(command "_erase" "l" "")
(if(not(tblsearch "LAYER" "C-BATR_SYMB"))
(command "-layer" "new" "C-BATR_SYMB" "Color" 252 "C-BATR_SYMB" "LTYPE" "Continuous" "C-BATR_SYMB" ""))
(setvar "clayer" "C-BATR_SYMB")
(setvar "celtype" "bylayer")
(setvar "cecolor" "bylayer")
  
(setq distbetween (getreal(strcat"\nSPECIFY DISTANCE BETWEEN BATTER TICKS: ")))
(setq divStep distbetween 
 stepLength 0.0
 stepLength2  divstep 
  )
  (setq BottomObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER>>"))))
  (setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT BOTTOM OF BATTER >>"))))
 
  (setq objLength (vlax-curve-getDistAtParam BottomObj (vlax-curve-getEndParam BottomObj)))
  (while (< stepLength objLength)

    (setq startPt
    (vlax-curve-getPointAtDist BottomObj stepLength))
    (setq startPt2
    (vlax-curve-getPointAtDist BottomObj stepLength2))

    (setq endPt
    (vlax-curve-getClosestPointTo
      UpperObj startPt)
      )
    (setq endPt2
    (vlax-curve-getClosestPointTo
      UpperObj startPt2)
      )

   (setq ang  (alg-ang BottomObj startPt))
   (setq ang2 (alg-ang BottomObj startPt2))
    
   (setq dis (distance  startPt endPt))
   (setq dis2 (/ (distance startPt2 endPt2) 2) )
   (setq endPt (polar startPt ang 1.))
   (setq endPt2 (polar startPt2 ang2 1.))
   (setq Xline (vlax-invoke acSp 'AddXLine startPt endPt))
   (setq Xline2 (vlax-invoke acSp 'AddXLine startPt2 endPt2))

   (if
   (setq endPt (vlax-invoke  Xline 'IntersectWith UpperObj 0))
   (progn
   (vlax-invoke acSp 'InsertBlock startPt "tick" 1 1 1 (- ang (* pi 2)));<-- change the block name here
   (vl-cmdf "_.scale" "l" "" startPt dis )
));end if
   
    (vla-delete Xline)
    (setq stepLength (+ stepLength divStep))
;end if
    (vla-delete Xline2)
    (setq stepLength2 (+ stepLength2 divStep))
  )
 
  (vlax-release-object BottomObj)
  (vlax-release-object UpperObj)

  (princ)
(COMMAND "_UNDO" "_E")
)

 

0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost