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

batter lisp need improvement

7 REPLIES 7
SOLVED
Reply
Message 1 of 8
marlance
1930 Views, 7 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") )

 

7 REPLIES 7
Message 2 of 8
CADaSchtroumpf
in reply to: marlance

Hi,My try with this...


Is not necessary that polyline have constant offset, the scale of block "TICK" is adjusted

(vl-load-com)
(defun z_dir (p1 p2 / )
  (trans
    '(0.0 1.0 0.0)
    (mapcar
      '(lambda (k)
        (/ k
          (sqrt
            (apply '+
              (mapcar
                '(lambda (x) (* x x))
                (mapcar '- p2 p1)
              )
            )
          )
        )
      )
      (mapcar '- p2 p1)
    )
    0
  )
)
(defun c:batter ( / js_b ent_b vla_obj_b param_start_b pram_end_b perim_obj pt_start_b deriv alpha 
                    js_t ent_t vla_obj_t param_start_t pt_start_t v1 v2 det_or
                    len_vtx d_x pt_ins param_pt pt_first pt_snd dxf_210 scale)
  (vl-load-com)
  (princ "\nSELECT BOTTOM OF BATTER >>")
  (while
    (not
      (setq js_b
        (ssget "_+.:E:S"
          (list
            (cons 0 "*POLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
            (cons -4 "<NOT")
            (cons -4 "&") (cons 70 120)
            (cons -4 "NOT>")
          )
        )
      )
    )
  )
  (setq
    ent_b (ssname js_b 0)
    vla_obj_b (vlax-ename->vla-object ent_b)
    param_start_b (vlax-curve-getStartParam vla_obj_b)
    param_end_b (vlax-curve-getEndParam vla_obj_b)
    perim_obj (vlax-curve-getDistAtParam vla_obj_b param_end_b)
    pt_start_b (vlax-curve-getPointAtParam vla_obj_b param_start_b)
    deriv (vlax-curve-getFirstDeriv vla_obj_b param_start_b)
    alpha (atan (cadr deriv) (car deriv))
  )
  (princ "\nSELECT TOP OF BATTER>>")
  (while
    (not
      (setq js_t
        (ssget "_+.:E:S"
          (list
            (cons 0 "*POLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
            (cons -4 "<NOT")
            (cons -4 "&") (cons 70 120)
            (cons -4 "NOT>")
          )
        )
      )
    )
  )
  (if (not (tblsearch "LAYER" "C-BATR_SYMB"))
    (entmake '((0 . "LAYER")
         (100 . "AcDbSymbolTableRecord")
         (100 . "AcDbLayerTableRecord")
         (2 . "C-BATR_SYMB")
         (70 . 0)
         (62 . 252)
         (370 . -3)
         (6 . "Continuous")
        )
    )
  )
  (setq
    ent_t (ssname js_t 0)
    vla_obj_t (vlax-ename->vla-object ent_t)
    param_start_t (vlax-curve-getStartParam vla_obj_t)
    pt_start_t (vlax-curve-getPointAtParam vla_obj_t param_start_t)
  )
  (setq
    v1 (mapcar '- (polar pt_start_b alpha 1.0) pt_start_b)
    v2
    (mapcar '-
      (vlax-curve-getClosestPointTo
        vla_obj_t
        pt_start_b
      )
      pt_start_b
    )
    det_or
    (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
      (append v1 v2)
    )
  )
  (cond
    ((< det_or 0.0) (setq ang_dir (- (* 0.5 pi))))
    ((> det_or 0.0) (setq ang_dir (* 0.5 pi)))
  )
  (if (not (tblsearch "BLOCK" "TICK"))
    (progn
      (entmake
        '(
          (0 . "BLOCK")
          (8 . "0")
          (2 . "TICK")
          (70 . 2)
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (10 0.0 0.0 0.0)
        )
      )
      (entmake
        '(
          (0 . "LINE")
          (100 . "AcDbEntity")
          (67 . 0)
          (410 . "Model")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (100 . "AcDbLine")
          (10 0.0 0.0 0.0)
          (11 0.5 -9.18455e-017 0.0)
          (210 0.0 0.0 1.0)
        )
      )
      (entmake
        '(
          (0 . "LWPOLYLINE")
          (100 . "AcDbEntity")
          (67 . 0)
          (410 . "Model")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (100 . "AcDbPolyline")
          (90 . 3)
          (70 . 129)
          (43 . 0.0)
          (38 . 0.0)
          (39 . 0.0)
          (10 0.5 -9.18455e-017)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.933013 -0.25)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.267949)
          (91 . 0)
          (10 0.933013 0.25)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (210 0.0 0.0 1.0)
        )
      )
      (entmake
        '(
          (0 . "ENDBLK")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
        )
      )
    )
  )
  (initget 7)
  (setq len_vtx (getdist "\nSPECIFY DISTANCE BETWEEN BATTER TICKS: "))
  (setq d_x 0.0)
  (while (< d_x perim_obj)
    (setq
      pt_ins (vlax-curve-getPointAtDist vla_obj_b d_x)
      param_pt (vlax-curve-getParamAtPoint vla_obj_b pt_ins)
      pt_first (vlax-curve-getPointAtParam vla_obj_b (fix param_pt))
      pt_snd (vlax-curve-getPointAtParam vla_obj_b (1+ (fix param_pt)))
      deriv (vlax-curve-getFirstDeriv vla_obj_b param_pt)
      alpha (atan (cadr deriv) (car deriv))
    )
    (if (null pt_snd)
      (setq pt_snd (vlax-curve-getEndPoint vla_obj_b))
    )
    (setq dxf_210 (z_dir pt_first pt_snd) scale (distance pt_ins (vlax-curve-getClosestPointTo vla_obj_t pt_ins)))
    (entmake
      (list
        (cons 0 "INSERT")
        (cons 100 "AcDbEntity")
        (assoc 67 (entget ent_b))
        (assoc 410 (entget ent_b))
        (cons 8 "C-BATR_SYMB")
        (cons 100 "AcDbBlockReference")
        (cons 2 "TICK")
        (cons 10 (trans (vlax-curve-getPointAtDist vla_obj_b d_x) 0 dxf_210))
        (cons 41 scale)
        (cons 42 scale)
        (cons 43 scale)
        (cons 50 (+ alpha ang_dir))
        (cons 210 dxf_210)
      )
    )
    (setq d_x (+ d_x len_vtx))
  )
  (prin1)
)

 

Message 3 of 8
marlance
in reply to: CADaSchtroumpf

 

 

 


@CADaSchtroumpf wrote:

Hi,My try with this...


Is not necessary that polyline have constant offset, the scale of block "TICK" is adjusted

 



Hi

 

works fine now but I want to change the shape of the batter with the drawing attached below.

 I tried to modify the entmaking of the line and polyline but still can't manage to change shape of the batter.

 

 

 

(entmake
        '(
          (0 . "LINE")
          (100 . "AcDbEntity")
          (67 . 0)
          (410 . "Model")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (100 . "AcDbLine")
          (10 0.0 0.0 0.0);;;;;is this the first point of the line?
          (11 0.5 -9.18455e-017 0.0);;;;second point of the line?           
(210 0.0 0.0 1.0)

 and how about the polyline?

how can i change the shape?

 

 

 

Message 4 of 8
CADaSchtroumpf
in reply to: marlance

Hi,

 

For change the shape, replace

  (if (not (tblsearch "BLOCK" "TICK"))
    (progn
      ...
      ...
    )
  )

 by this:

  (if (not (tblsearch "BLOCK" "TICK"))
    (progn
      (entmake
        '(
          (0 . "BLOCK")
          (8 . "0")
          (2 . "TICK")
          (70 . 2)
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (10 0.0 0.0 0.0)
        )
      )
      (entmake
        '(
          (0 . "LINE")
          (100 . "AcDbEntity")
          (67 . 0)
          (410 . "Model")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (100 . "AcDbLine")
          (10 0.0 0.0 0.0)
          (11 0.47245 0.0 0.0)
          (210 0.0 0.0 1.0)
        )
      )
      (entmake
        '(
          (0 . "LWPOLYLINE")
          (100 . "AcDbEntity")
          (67 . 0)
          (410 . "Model")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (100 . "AcDbPolyline")
          (90 . 16)
          (70 . 129)
          (43 . 0.0)
          (38 . 0.0)
          (39 . 0.0)
          (10 0.47245 0.0)
          (40 . 0.0)
          (41 . 0.0)
          (42 . -0.116132)
          (91 . 0)
          (10 0.4951 -0.0065)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.7458 -0.1695)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0607686)
          (91 . 0)
          (10 0.869 -0.2337)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.279764)
          (91 . 0)
          (10 0.9038 -0.226)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.9378 -0.1977)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.167269)
          (91 . 0)
          (10 0.983 -0.113)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.9943 -0.0564)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0504035)
          (91 . 0)
          (10 1.0 0.0)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0504035)
          (91 . 0)
          (10 0.9943 0.0564)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.983 0.113)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.167269)
          (91 . 0)
          (10 0.9378 0.1977)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.9038 0.226)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.279764)
          (91 . 0)
          (10 0.869 0.2337)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0607686)
          (91 . 0)
          (10 0.7458 0.1695)
          (40 . 0.0)
          (41 . 0.0)
          (42 . 0.0)
          (91 . 0)
          (10 0.4951 0.0065)
          (40 . 0.0)
          (41 . 0.0)
          (42 . -0.116132)
          (91 . 0)
          (210 0.0 0.0 1.0)
        )
      )
      (entmake
        '(
          (0 . "ENDBLK")
          (8 . "0")
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
        )
      )
    )
  )

 Is the TICK.dwg, but I have moved the insertion point and the rotation (180°)  and parameter is fixed  at "ByBlock"

Message 5 of 8
marlance
in reply to: CADaSchtroumpf

Hi

 

can you rotate the block to 180° and move the insertion point.

the insertion point should be on top that's why i want it to be like this.

 

block.PNG

Message 6 of 8
marlance
in reply to: marlance

problem solved already

just change the value of those highlighted  in red

 

  (cond
    ((< det_or 0.0) (setq ang_dir (- (/ (* 3 pi) 2 ))))
    ((> det_or 0.0) (setq ang_dir (/ (* 3 pi) 2 )))

...................

 

  (if (not (tblsearch "BLOCK" "TICK"))
    (progn
      (entmake
        '(
          (0 . "BLOCK")
          (8 . "0")
          (2 . "TICK")
          (70 . 2)
          (62 . 0)
          (6 . "ByBlock")
          (370 . -2)
          (10 1.0 0.0 0.0)

..................................

Message 7 of 8

Hello

 

Can you add half  the size of tadpole between to tadpoles?

 

thanks

Message 8 of 8
alex.mcpherson
in reply to: marlance

can you make lisp available for download please

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

Post to forums  

Autodesk Design & Make Report

”Boost