Jump to content

I need Help for lisp align text, in centeroid close polyline, settx-cek-allign

cepsoe12

By cepsoe12
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

cepsoe12 Apprentice

cepsoe12

Posted
Posted 
(command "style""ARIAL""ARIAL""0""1""0""n""n")
(setq spasi 1.5)

(defun polykor()
(setq i 1)
(setq n 0)
(repeat
(setq lent (length ent))
(setq k (nth n ent))
(setq k10 (car k))
(if 
(= k10 10)
(PROGN
(setq kor (cdr k))
(print kor)
(command "point"kor)
(setq i (+ i 1))
))
(setq n (+ n 1))
))

(setvar "dimzin" 0)

(defun tengahbidang()
(setq entobjek (entget (car klikpolykor)))
(setq nobjek 0)
(setq xobjek2 0)
(setq yobjek2 0)
(setq nloop 0)
(REPEAT
(setq lentobjek (length entobjek))
(setq isiobjek (nth nobjek entobjek))
(setq isiobjek10 (car isiobjek))
(IF 
(= isiobjek10 10)
(PROGN
(setq korobjek (cdr isiobjek))
(print korobjek)
(setq xobjek (car korobjek))
(setq yobjek (cadr korobjek))
(setq xobjek2 (+ xobjek2 xobjek))
(setq yobjek2 (+ yobjek2 yobjek))
(setq nloop (+ nloop 1))
))
(setq nobjek (+ nobjek 1))
(IF
(= nobjek lentobjek)
(PROGN
(setq xxobjek (/ xobjek2 nloop))
(setq yyobjek (/ yobjek2 nloop))
(setq titiktengah (list xxobjek yyobjek))
(entmake
  (list
      (cons 0 "POINT")
       (cons 8 "PolBid")
       (cons 62 50)
       (cons 10 titiktengah)
      )
     )
))
))


(defun c:settx()
(setq el0 (entsel "\nSelect Text NIB"))
(setq lay0 (cdr (assoc 8 (entget (car el0)))))
(IF
(setq el1 (entsel "\nSelect Text Nama"))
(setq lay1 (cdr (assoc 8 (entget (car el1)))))
)
(IF
(setq el2 (entsel "\nSelect Text NUB"))
(setq lay2 (cdr (assoc 8 (entget (car el2)))))
)
(IF
(setq el3 (entsel "\nSelect Text Luas"))
(setq lay3 (cdr (assoc 8 (entget (car el3)))))
)

(IF
(= el1 nil)
(setq lay1 "-")
)
(IF
(= el2 nil)
(setq lay2 "-")
)
(IF
(= el3 nil)
(setq lay3 "-")
)
(setq th (getreal "\nTinggi Huruf : "))
)


(defun plotteks()
(setq korteks (list xtengah (+ ytengah (* th (* spasi kali)))))
(setq elteks (list entteks korteks))
(command "erase""single"elteks)
(entmake
  (list
      (cons 0 "TEXT")
       (cons 8 tlay)
       (cons 40 th)
       (cons 1 teks)
       (cons 50 0)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 korteks)
       (cons 11 korteks)
      )
     )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cek()
(setq gp1 (getpoint "\nKlik Kiri Bawah Peta Bidang !"))
(setq x1 (car gp1))
(setq y1 (cadr gp1))
(setq gp2 (getcorner gp1 "\nKlik Kanan Atas Peta Bidang !"))
(setq x2 (car gp2))
(setq y2 (cadr gp2))

(setq ss (ssget "_c" gp1 gp2 '((0 . "TEXT"))))
(REPEAT
(setq sl (sslength ss))
(setq sn (ssnamex ss (- sl 1)))
(setq ent1 (cdr (assoc -1 (entget (cadar sn)))))
(setq ent2 (cdr (assoc 330 (entget (cadar sn)))))
(setq th (cdr (assoc 40 (entget (cadar sn)))))
(setq tx (cdr (assoc 1 (entget (cadar sn)))))
(setq ro (cdr (assoc 50 (entget (cadar sn)))))
(setq sty (cdr (assoc 7 (entget (cadar sn)))))
(setq kor1 (cdr (assoc 10 (entget (cadar sn)))))
(setq kor2 (cdr (assoc 11 (entget (cadar sn)))))
(setq lay (cdr (assoc 8 (entget (cadar sn)))))
(IF
(= lay lay0)
(PROGN
(setq eltx (list ent1 kor1))
(command "erase""single"eltx)
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay0)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
(command "bpoly"kor2"")
))

(IF
(= lay lay1)
(PROGN
(setq eltx (list ent1 kor1))
(command "erase""single"eltx)
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay1)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
))

(IF
(= lay lay2)
(PROGN
(setq eltx (list ent1 kor1))
(command "erase""single"eltx)
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay2)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
))

(IF
(= lay lay3)
(PROGN
(setq eltx (list ent1 kor1))
(command "erase""single"eltx)
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay3)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
))

(IF
(= lay lay4)
(PROGN
(setq eltx (list ent1 kor1))
(command "erase""single"eltx)
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay4)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
))


(setq sl (- sl 1))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:allign()
(setq ssbo (ssget '((0 . "LWPOLYLINE")(8 . "PolBid"))))
(REPEAT
(setq slbo (sslength ssbo))
(setq snbo (ssnamex ssbo (- slbo 1)))
(setq entbo (cdr (assoc -1 (entget (cadar snbo)))))
(setq korbo (cdr (assoc 10 (entget (cadar snbo)))))
(setq elbo (list entbo korbo))
(setq ent (entget (car elbo)))
(polykor)
(setq klikpolykor (list entbo korbo))
(tengahbidang) 

(setq ssttk (ssget "x" '((0 . "point")(8 . "PolBid")(62 . 256))))
(command "select""wp")
(REPEAT
(setq slttk (sslength ssttk))
(setq snttk (ssnamex ssttk (- slttk 1)))
(setq entttk (cdr (assoc -1 (entget (cadar snttk)))))
(setq korttk (cdr (assoc 10 (entget (cadar snttk)))))
(command korttk)
(setq slttk (- slttk 1))
(IF
(= slttk 0)
(PROGN
(setq prc (princ))
(command """")
(setq sstengah (ssget "p" (LIST (cons 0 "POINT")(cons 8 "PolBid")(cons 62 50))))
(setq sntengah (ssnamex sstengah 0))
(setq kortengah (cdr (assoc 10 (entget (cadar sntengah)))))
(setq xtengah (car kortengah))
(setq ytengah (cadr kortengah))
))
)


(setq ssttk (ssget "x" '((0 . "point")(8 . "PolBid")(62 . 256))))
(command "select""wp")
(REPEAT
(setq slttk (sslength ssttk))
(setq snttk (ssnamex ssttk (- slttk 1)))
(setq entttk (cdr (assoc -1 (entget (cadar snttk)))))
(setq korttk (cdr (assoc 10 (entget (cadar snttk)))))
(command korttk)
(setq slttk (- slttk 1))
(IF
(= slttk 0)
(PROGN
(setq prc (princ))
(command """")
(command "change""single""p""p""c""50""")
))
)


(setq ssteks (ssget "x" (LIST (cons 0 "TEXT")(cons 62 50))))
(REPEAT
(setq slteks (sslength ssteks))
(setq snteks (ssnamex ssteks (- slteks 1)))
(setq entteks (cdr (assoc -1 (entget (cadar snteks)))))
(setq teks (cdr (assoc 1 (entget (cadar snteks)))))
(setq layteks (cdr (assoc 8 (entget (cadar snteks)))))
(IF
(= layteks lay0)
(PROGN
(setq tlay lay0)
(setq kali 0)
(plotteks)
))
(IF
(= layteks lay1)
(PROGN
(setq tlay lay1)
(setq kali 1)
(plotteks)
))
(IF
(= layteks lay2)
(PROGN
(setq tlay lay2)
(setq kali 2)
(plotteks)
))
(IF
(= layteks lay3)
(PROGN
(setq tlay lay3)
(setq kali -1)
(plotteks)
))
(IF
(= layteks lay4)
(PROGN
(setq tlay lay4)
(setq kali -2)
(plotteks)
))


(setq slteks (- slteks 1))


(IF
(= slteks 0)
(PROGN
(princ)
(IF
(setq ssttk (ssget "x" '((0 . "POINT")(8 . "PolBid"))))
(command "erase""single"ssttk)
)
(IF
(setq ssttk (ssget "x" '((0 . "TEXT")(62 . 50))))
(command "change""single"ssttk"p""c""bylayer""")
)
))




)



(setq slbo (- slbo 1))
))




(PRINT)

marko_ribar Veteran

marko_ribar

Posted
Posted

Don't have a time to test, but try replacing (this kind of syntax wherever it occurs) :

 

(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay0)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 kor2)
       (cons 11 kor2)
      )
     )
(command "bpoly"kor2"")

 

with this (syntax) :

 

(command "bpoly"kor2"")
(setq c (LM:PolyCentroid (entlast)))
(entmake
  (list
      (cons 0 "TEXT")
       (cons -1 ent1)
       (cons 330 ent2)
       (cons 8 lay0)
       (cons 40 0.5)
       (cons 1 tx)
       (cons 50 ro)
       (cons 7 sty)
       (cons 71 0)
       (cons 72 1)
       (cons 73 2)
       (cons 10 c)
       (cons 11 c)
      )
     )

 

Note : It is important that you change order of things that are processed - you should firstly get "c" - centroid and then create TEXT...

 

And make sure you load this sub before you run LISP, or implement it along within...

 

http://www.lee-mac.com/polygoncentroid.html

 

BTW. Sub function (LM:PolyCentroid e) is only applicable for LWPOLYLINE entity that have all segments straight - polygonal LWPOLYLINE - it must not have arcs and shape doesn't matter - so it can be irregular (not just like POLYGON command functionality)... But be aware that correct look - (not selfintersecting) and property - (closed) play important role in determining correct centroid position...

 

Also, for good practice - not to go too deeply in all possible situations, change current UCS to WCS and apply (LM:PolyCentroid lw) function only on LWPOLYLINE entities that lie in WCS (they are drawn normal way) before applying routine...

  • Thanks 1
cepsoe12 Apprentice

cepsoe12

Posted
  • Author
Posted

Thanks masters 😀, align area Text, this really helped my work but I have more than 5000 area land😰, which already have 4 Text layers,

I have to do it again, in LIsp SETTX-CEK-ALLIGN.lsp not going well,

i need help to fix lisp and learn from the masters here. 

thank you for taking the time to help me

1138999178_bandicam2022-02-2014-52-09-162.gif

mhupp Grand Master

mhupp

Posted
Posted

This will get the geometric center point. probably save some time without adding and deleting regions.

  • Like 1
devitg Experienced

devitg

Posted
Posted

please test it . It make region on REGION-POLY layer . If need all region can be deleted 

  

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2022 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;
; ----------------------------------------------------------------------
; DISCLAIMER:  Gabriel Calos De Vit Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold Gabriel Calos De Vit harmless from such claims.
; Gabriel Calos De Vit makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
;;************************************************************


;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
(DEFUN VAR->LST  (VARIANT#) ;_01
  (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE VARIANT#))
  )
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*


;;;center-text-centroid
;;;(setq obj POLi)

(DEFUN &-REGION/OBJ  (OBJ) ;_ 01
  (IF (= (TYPE OBJ) 'ENAME)
    (SETQ OBJ (VLAX-ENAME->VLA-OBJECT OBJ)
          )
    )
  (SETQ LISTA (LIST OBJ))
  (ERRORTRAP (QUOTE (SETQ REGION# (CAR (VLAX-INVOKE MODEL "addregion" LISTA)))))
  REGION#
  )
;;************************************************************
(DEFUN G-COORD-->LIST/OBJ  (OBJ / CONT END-PAR PTOS-POLY) ;-001
  (DEFUN CONT0  () ;-0001
    (SETQ CONT 0)
    ) ;_defun cont0
  (DEFUN CONT1  () ;-0001
    (SETQ CONT (1+ CONT))
    )
  (IF (= (TYPE OBJ) 'ENAME)
    (SETQ OBJ (VLAX-ENAME->VLA-OBJECT OBJ))
    ) ;_ convierte una ename en vlaobject 
  (SETQ PTOS-POLY-LST NIL)
  (SETQ END-PAR (VLAX-CURVE-GETENDPARAM OBJ))
  (CONT0)
  (REPEAT (1+ (FIX END-PAR))
    (SETQ PTOS-POLY (VLAX-CURVE-GETPOINTATPARAM OBJ CONT))
    (IF (/= (LENGTH PTOS-POLY) 3)
      (SETQ PTOS-POLY (REVERSE (CDR (REVERSE PTOS-POLY))))
      (SETQ PTOS-POLY-LST (CONS PTOS-POLY PTOS-POLY-LST))
      )
    (CONT1)
    ) ;_  
  (REVERSE PTOS-POLY-LST)
  )


;;************************************************************************************************************
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/



(DEFUN &-CIRCLE-CO/P1-R1-CO  (P1 R1 CO)
  (IF (= (TYPE P1) 'LIST)
    (SETQ P1 (VLAX-3D-POINT P1)))
  (IF (= CO NIL)
    (SETQ CO ACBYLAYER)
    )
  (SETQ CIRCLE# (VLA-ADDCIRCLE MODEL P1 R1))
  (VLA-PUT-COLOR CIRCLE# CO)
  CIRCLE#
  )
;;************************************************************
;;************************************************************
(DEFUN BUTLAST  (LST)
  (REVERSE (CDR (REVERSE LST)))
  
  )


;;;*************************************************************;;;


(defun center-text-centroid (/
                            )

  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  (SETQ SELECTIONSETS (VLA-GET-SELECTIONSETS ADOC))
  (setq lay-coll (VLA-GET-LAYERS adoc))

  (setq nub-nro-ss (ssget "_X" '((0 . "TEXT") (8 . "NUB"))))

  (setq nub-nro-obj-ss (VLA-GET-ACTIVESELECTIONSET adoc))

  (command-s "-layer" "M" "region-poly" "")

 ;(setq nub-nro-obj (vla-item nub-nro-obj-ss 0))

  (vlax-for
         nub-nro-obj nub-nro-obj-ss

    (setq nub-nro-xy
           (REVERSE
             (CDR (REVERSE
                    (VLAX-SAFEARRAY->LIST
                      (VLAX-VARIANT-VALUE (VLA-GET-INSERTIONPOINT nub-nro-obj))
                    ) ;_  VLAX-SAFEARRAY->LIST
                  ) ;_  REVERSE
             ) ;_  CDR
           ) ;_  REVERSE
    ) ;_  setq


    (VL-CMDF "-boundary" nub-nro-xy "")

    (setq bound (entlast))

    (VL-CMDF "_region" bound "")

    (setq region (entlast))

    (setq region-obj (EN2OB region))
    (setq region-centroid-xyz
           (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-CENTROID region-obj)))
    ) ;_  setq

    (&-CIRCLE-CO/P1-R1-CO region-centroid-xyz 1.5 acgreen)
;;;    (&-CIRCLE-CO/P1-R1-CO nub-nro-xy 0.5 acred)



    (setq bound-xy (mapcar 'BUTLAST (G-COORD-->LIST/OBJ bound)))

    (setq text@bound (ssget "wp" bound-xy '((0 . "TEXT"))))

    (setq text-10 (cdr (assoc 10 (entget (ssname text@bound 0)))))

    (&-CIRCLE-CO/P1-R1-CO text-10 1 acred)

    (VL-CMDF "_MOVE" text@bound "" text-10 region-centroid-xyz)

  ) ; end  vlax-for
) ;end defun get-node-at-reducer 

(defun c:cent-text ()
(center-text-centroid)
  
  )

 

center text on centroid- move the block before.dwg

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...