CURVE LABEL

Discussion in 'AutoCAD' started by ~DEVO~, Dec 7, 2004.

  1. ~DEVO~

    ~DEVO~ Guest

    Hello everyone, I need some help with this lisp. What this lisp does is it prompts you to select an arc... then using an existing block with the arc number, delta, length, tangent, and radius labels as an attribute...it fills in the label of the attribute. The problem that I am having is that it's not placing the info in its proper label slot. It puts the tangent info in the length label and the radius in the arc number label...etc.

    I have been trying to solve this issue, but no luck. Can anyone help?


    (DEFUN C:CT ()
    (SETVAR "CMDECHO" 0)
    (IF (= Tsize NIL) (SETQ tsize (GETREAL "TEXT HEIGHT: ")))
    (IF (= PRECISION NIL) (SETQ PRECISION (GETINT "PRECISION: ")))
    (IF (= CRVLBLNUM NIL) (SETQ CRVLBLNUM (GETINT "STARTING CURVE LABEL NUMBER: ")))
    (COMMAND "OSNAP" "NONE")
    (setq X (entsel "SELECT ARC: "))
    (SETQ PI 3.14159265)
    (SETQ 2PI (* 3.14159265 2))
    (WHILE (/= X NIL)
    (setq has (car X))
    (setq ent (entget has))
    (setq RAD (cdr (assoc 40 ent)))
    (SETQ CEN (CDR (ASSOC 10 ENT)))
    (SETQ BEGANG (CDR (ASSOC 50 ENT)))
    (SETQ ENDANG (CDR (ASSOC 51 ENT)))
    (SETQ BEGANGSTR (ANGTOS BEGANG 1 4))
    (SETQ ENDANGSTR (ANGTOS ENDANG 1 4))
    (SETQ BEGANG (ANGTOF BEGANGSTR 4))
    (SETQ ENDANG (ANGTOF ENDANGSTR 4))
    (SETQ BEGPT (POLAR CEN BEGANG RAD) )
    (SETQ ENDPT (POLAR CEN ENDANG RAD) )
    (SETQ DELTA (ABS (- BEGANG ENDANG)))
    (IF (> BEGANG ENDANG) (SETQ DELTA (- 2PI DELTA)))

    ;=================================================
    ;
    (PRINT DELTA)
    (SETQ DUMMYSTRING (ANGTOS DELTA 1 4))
    (SETQ DELTA (ANGTOF DUMMYSTRING 1))
    (PRINT DELTA)
    ;=================================================
    (SETQ DELTADEC (/ (* DELTA 180) PI))

    (PRINT DELTA)
    (SETQ DEGRE (FIX DELTADEC))
    (SETQ DEGREDEC (- DELTADEC DEGRE))
    (SETQ MINUTE (FIX (* DEGREDEC 60)))
    (SETQ MINUTEDEC (- (* DEGREDEC 60) MINUTE))
    (SETQ SECOND (* MINUTEDEC 60))
    (IF (< MINUTE 10) (SETQ MINU (STRCAT "0" (ITOA MINUTE))) (SETQ MINU (ITOA MINUTE)))
    (IF (< SECOND 10) (SETQ SECO (STRCAT "0" (RTOS SECOND 2 0))) (SETQ SECO (RTOS SECOND 2 0)))
    (SETQ DLTTA (STRCAT (ITOA DEGRE) "%%d" MINU "'" SECO "''"))
    (SETQ RADUS (STRCAT (RTOS RAD 2 PRECISION) "'"))
    (SETQ CLEN (* (/ PI 180) DELTADEC RAD))
    (SETQ LNGTH (STRCAT (RTOS CLEN 2 PRECISION) "'"))
    (SETQ TANGNT "-")
    (IF (<= DELTA PI) (PROGN
    (SETQ CTAN (* RAD (/ (SIN (/ DELTA 2)) (COS (/ DELTA 2)))))
    (PRINT CTAN)
    (SETQ CTAN (ABS CTAN))
    (SETQ TANGNT (STRCAT (RTOS CTAN 2 PRECISION) "'")) ))

    (PRINT DLTTA) (PRINT RADUS) (PRINT LNGTH)

    (SETQ ZZZ (STRCAT "CURVE LABEL NUMBER: " (RTOS CRVLBLNUM 2 0)))
    (SETQ CLBL (GETINT ZZZ))
    (IF (/= CLBL NIL) (SETQ CRVLBLNUM CLBL))

    (setq p1 begpt)
    (setq p2 endpt)



    (SETQ X1 (CAR P1))
    (SETQ Y1 (CAR (CDR P1)))
    (SETQ X2 (CAR P2))
    (SETQ Y2 (CAR (CDR P2)))
    (SETQ X1ST (RTOS X1 2 10))
    (SETQ Y1ST (RTOS Y1 2 10))
    (SETQ X2ST (RTOS X2 2 10))
    (SETQ Y2ST (RTOS Y2 2 10))
    (SETQ DX (- X2 X1))
    (SETQ DY (- Y2 Y1))
    (SETQ PT (LIST (/ (+ X1 X2) 2) (/ (+ Y1 Y2) 2)))
    (SETQ LEN (DISTANCE P1 P2))
    (SETQ LENSTR (STRCAT (RTOS LEN 2 PRECISION) "'"))
    (PRINT LENSTR)
    (SETQ ANG (ATAN DY DX))
    (IF (= (ABS ANG) (/ PI 2)) (SETQ TEXTANG (ABS ANG)) )
    (IF (< (ABS ANG) (/ PI 2)) (SETQ TEXTANG ANG))
    (IF (> (ABS ANG) (/ PI 2)) (SETQ TEXTANG (+ ANG PI)))
    (SETQ ANGSTR (ANGTOS (ATAN DY DX) 4 4))
    (SETQ TEXTANGSTR (ANGTOS TEXTANG 4 4))
    (SETQ PT2STR (STRCAT ANGSTR " " LENSTR))

    (COMMAND "INSERT" "CRVLBL" PT TSIZE TSIZE TEXTANGSTR CRVLBLNUM DLTTA RADUS LNGTH TANGNT)
    (SETQ CRVLBLNUM (+ CRVLBLNUM 1))

    (setq X (entsel "Pick ARC: "))


    ; (SETQ INS1 (GETPOINT "STARTING POINT : "))
    ; (SETQ INS2 (GETPOINT INS1 "ROTATION : "))
    ; (if (= ins2 nil) (setq ins2 0))
    ; (COMMAND "INSERT" "CRVLBL" INS1 TSIZE TSIZE INS2 CRVLBLNUM DLTTA RADUS LNGTH TANGNT)
    ; (SETQ CRVLBLNUM (+ CRVLBLNUM 1))

    ; (setq X (entsel "Pick ARC: "))
    )


    )
     
    ~DEVO~, Dec 7, 2004
    #1
  2. ~DEVO~

    ~DEVO~ Guest

    forgot to mention........i use acad2004
     
    ~DEVO~, Dec 7, 2004
    #2
  3. Hi,

    When you populate the attribute fields in a block, they are populated in the
    order the attributes were selected when making the block definition.

    Hence you need to redefine the block to match you lisp code, or re-order the
    lisp code to match the block definition.

    Simply experiment with the parameter order in the line:
    LNGTH TANGNT)

    --


    Laurie Comerford
    CADApps
    www.cadapps.com.au

    prompts you to select an arc... then using an existing block with the arc
    number, delta, length, tangent, and radius labels as an attribute...it fills
    in the label of the attribute. The problem that I am having is that it's not
    placing the info in its proper label slot. It puts the tangent info in the
    length label and the radius in the arc number label...etc.
     
    Laurie Comerford, Dec 7, 2004
    #3
  4. ~DEVO~

    ~DEVO~ Guest

    Okay..got it to work thanks a lot. One more question. i am trying to run another lisp .... I wrote in as such:

    (setq lst2 (sort lst2))

    It should run "lst2" thru a little lisp to obtain a new "lst2" value.
    For some reason it is not working correctly. Is the codeing bad?

    Example: if lst2 = 1 2 3 4
    lst2 goes to the lisp labeled "sort" and should returm 4 3 2 1

    here is the sort lisp...

    ( defun SORT (Lst / NewList temp big TempList y x limit)
    ( setq x (length Lst) )
    ( while ( /= x 1)
    ( setq pos 0 )
    ( setq big (nth pos Lst) )
    ( setq i 1 )
    ( setq limit (- x 1 ) )
    ( repeat limit
    ( setq temp (nth i Lst) )
    ( if (> (atoi (car temp)) (atoi (car big)) )
    ( setq big temp pos i )
    )
    ( setq i (+ i 1) )
    )

    ( setq NewList ( cons big NewList ) )
    ( if ( = pos 0 )
    ( setq Lst (cdr Lst) )
    ( progn
    ( setq TempList (list (car Lst)) )
    ( setq y (length Lst))
    ( setq y (- y 1) i 0 )
    ( while (< i y )
    ( setq i (+ 1 i) )
    ( if ( /= pos i )
    ( setq TempList (cons (nth i Lst) TempList))
    )
    )
    ( setq Lst TempList )
    )
    )
    ( setq x (- x 1) )
    )
    (setq NewList ( cons (car Lst) NewList ) )
    (setq Lst NewList )
    )
     
    ~DEVO~, Dec 10, 2004
    #4
  5. ~DEVO~

    ~DEVO~ Guest

    I think you can call it a lisp with-in a lisp..... yeah , that's what it is...
     
    ~DEVO~, Dec 10, 2004
    #5
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.