Old Bell JMOS programs to fill step markers and boarders

[aaronic_abacus]

[ Moderator Action = ON ] What are [ CODE ] tags... [ Moderator Action = OFF ]

;This program numbers JMOS(Bell symbol) blocks from left to right and top to bottom.
;(see attachments)

(DEFUN C:JFILL (/ VCT FLTR SN CNT LUP CJS JSS CJSL CT LP CCJ CT2 LP2 CJ MST CJL CJP CJX CJH CJY CNT JSSL CT3 LP3 JN JAN JANL SNA SNV NSNA NJANL)
(PROMPT "\n*JMOS STEP FILL*")
(SETQ VCT (GETVAR "VIEWCTR"))
(SETQ FLTR '((2 . "4")))
(SETQ SN 1)
(SETQ CNT 1)
(SETQ LUP 1)
(WHILE LUP
(SETQ CJS (SSGET "X" FLTR))
(IF (/= CJS NIL) (PROGN
(SETQ JSS (SSADD))
(SETQ CJSL (SSLENGTH CJS))
(SETQ CT (- CJSL 1))
(SETQ LP 1)
(WHILE LP
(SETQ CCJ (+ (CAR VCT) 900000))
(SETQ CT2 (- CJSL 1))
(SETQ LP2 1)
(WHILE LP2
(SETQ CJ (SSNAME CJS CT2))
(SETQ MST (SSMEMB CJ JSS))
(SETQ CJL (ENTGET CJ))
(SETQ CJP (CDR (ASSOC 10 CJL))) 
(SETQ CJX (CAR CJP))
(IF (AND (= MST NIL) (< CJX CCJ)) (PROGN (SETQ CCJ CJX) (SETQ CJH CJ)) )
(SETQ CT2 (- CT2 1))
(IF (< CT2 0) (SETQ LP2 NIL))
);END LP2
(SETQ JSS (SSADD CJH JSS))
(SETQ CT (- CT 1))
(IF (< CT 0) (SETQ LP NIL))
);END LP
(SETQ CJS JSS)
(SETQ JSS (SSADD))
(SETQ CT (- CJSL 1))
(SETQ LP 1)
(WHILE LP
(SETQ CCJ (+ (CAR (CDR VCT)) 900000))
(SETQ CT2 (- CJSL 1))
(SETQ LP2 1)
(WHILE LP2
(SETQ CJ (SSNAME CJS CT2))
(SETQ MST (SSMEMB CJ JSS))
(SETQ CJL (ENTGET CJ))
(SETQ CJP (CDR (ASSOC 10 CJL))) 
(SETQ CJY (CAR (CDR CJP)))
(IF (AND (= MST NIL) (< CJY CCJ)) (PROGN (SETQ CCJ CJY) (SETQ CJH CJ)) )
(SETQ CT2 (- CT2 1))
(IF (< CT2 0) (SETQ LP2 NIL))
);END LP2
(SETQ JSS (SSADD CJH JSS))
(SETQ CT (- CT 1))
(IF (< CT 0) (SETQ LP NIL))
);END LP
(SETQ JSSL (SSLENGTH JSS))
(SETQ CT3 (- JSSL 1))
(SETQ LP3 1)
(WHILE LP3
(SETQ JN (SSNAME JSS CT3))
(SETQ JAN (ENTNEXT JN))
(SETQ JANL (ENTGET JAN))
(SETQ SNA (ASSOC 1 JANL))
(SETQ SNV (CDR SNA))
(SETQ NSNA (CONS 1 (ITOA SN)))
(SETQ NJANL (SUBST NSNA SNA JANL))
(ENTMOD NJANL)
(SETQ SN (+ SN 1))
(SETQ CT3 (- CT3 1))
(IF (< CT3 0) (SETQ LP3 NIL))
);END LP3
));END PROGN/IF
(SETQ CNT (+ CNT 1))
(IF (= CNT 2) (PROGN (SETQ FLTR '((2 . "2"))) (SETQ SN 31)))
(IF (= CNT 3) (PROGN (SETQ FLTR '((2 . "WL1"))) (SETQ SN 61)))
(IF (= CNT 4) (SETQ LUP NIL))
);END LUP
(COMMAND "REGEN")
(PRINC)
);END JFILL

;and this program fills the border with the range of JMOS symbols (all below)
;(see attachments)


; jscan.lsp
;
;
;   5-13-94     Revise to 'Barryize' JMOS format
;
;
(defun c:jscan()
    (jscan_main)
    (princ)
) jscan
(defun jscan_main()
    (setq jsum nil
          jstep nil
          jmos_list nil
          temp_list nil
          duplist nil
          jmos_sym_list
              (reverse
                  (list "4" "2" "WL1")    ; jmos symbols MUST be listed in
              )                           ; order of desired occurence
          count
              (1-
                  (length jmos_sym_list)
              )
          dupflag nil
          dupmsg "WARNING!  DUPLICATE OCCURENCE OF JMOS STEP "
    ); setq
    (while
        (>= count 0)
        (setq sset
            (getsset
                (nth count jmos_sym_list)
            )
            duplist nil
        )
        (if sset
            (getjstep)
            (dfltjstep)
        ); end if
        (setq jsum
            (cons loval jsum)
        )
        (setq jsum
            (cons hival jsum)
        )
        (setq count
            (1- count)
        )
    ); end while
    (updjmos)
    (if dupflag
        (textscr)
    ); end if
);jscan_main
;
;
;
;
;
;
(defun getjstep()
    (setq loval 999)
    (setq hival 0)
    (setq entname
        (ssname sset 0)
    )
    (setq jstep nil)
    (while entname
        (setq ent
            (entget entname)
        )
        (setq attval
            (dxf 1
                (entget
                    (entnext
                        (dxf -1 ent)
                    )
                )
            )
        )
        (cond
            (
                (not
                    (eq
                        (atoi attval)
                        0
                    )
                )
                (dupstep)
                (setq jstep
                    (cons
                        (atoi attval)
                        jstep
                    )
                )
            )
        ); end if
        (ssdel entname sset)
        (setq entname
            (ssname sset 0)
        )
    ); end while
    (foreach curval jstep
        (setq loval
            (min curval loval)
        )
    )
    (foreach curval jstep
        (setq hival
            (max curval hival)
        )
    )
    (setq loval
        (itoa loval)
    )
    (setq hival
        (itoa hival)
    )
    (if
        (or
            (<
                (atoi loval)
                 1
             )
            (<
                (atoi hival)
                1
            )
        )
        (dfltjstep)
    ); end if
    (if
        (= loval hival)
        (setq
            hival
                "-"
        )
    )
);getjstep
;
;
;
(defun dfltjstep()
    (setq loval "-")
    (setq hival "-")
);dfltjstep
;
;
;
;
(defun updjmos(/ ts)
    (setq sset
        (getsset "jmos")
    )
    (setq ts (getsset "titlea"))
    (if (= ts nil) (setq ts (getsset "titleb")))
    (if
        (not sset)
        (setq sset
            ts
        )
    ); end if
    (setq entname
        (ssname sset 0)
    )
    (setq ent
        (entget entname)
    )
    (setq jmos_list nil)
    (while
        (not
            (eq
                (dxf 0 ent)
                "SEQEND"
            )
        )
        (if
            (eq
                (dxf 2 ent)
                "WL"
            )
            (setq jmos_list
                (cons
                    (dxf -1 ent)
                    jmos_list
                )
            )
        ); end if
        (setq ent
            (entget
                (entnext
                    (dxf -1 ent)
                )
            )
        )
    ); end while
    (cond
        (
            (eq
                (length jmos_list)
                8
            )
            (setq jmos_list
                (reverse jmos_list)
            )
            (setq count 7)
            (while
                (> count 1)
                (setq temp_list
                    (cons
                        (nth count jmos_list)
                        temp_list
                    )
                )
                (setq count
                    (1- count)
                )
            ); end while
            (setq jmos_list
                (reverse temp_list)
            )
        )
    ); end cond
    (setq count 0)
    (while (< count 6)
        (setq ent
            (entget
                (nth count jmos_list)
            )
        )
        (setq new
            (cons 1
                (nth count jsum)
            )
        )
        (setq old
            (assoc 1 ent)
        )
        (setq ent
            (subst new old ent)
        )
        (entmod ent)
        (setq count
            (1+ count)
        )
    ); end while
    (entupd entname)
);updjmos
;
;
(defun dupstep()
    (cond
        (
            (member attval duplist)
            (alert
                (print
                    (strcat dupmsg attval)
                )
            )
            (setq dupflag 1)
        )
    )
    (setq duplist
        (cons attval duplist)
    )
); dupstep
;
(jscan_main)
;
(princ)